COMMENT ⊗   VALID 00040 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	   -*-MIDAS-*-
C00007 00003
C00009 00004
C00011 00005
C00012 00006
C00013 00007
C00017 00008
C00023 00009
C00027 00010
C00028 00011
C00033 00012
C00036 00013
C00041 00014
C00044 00015
C00047 00016
C00050 00017
C00051 00018
C00053 00019
C00055 00020
C00056 00021
C00058 00022
C00061 00023
C00063 00024
C00066 00025
C00067 00026
C00071 00027
C00074 00028
C00077 00029
C00080 00030
C00083 00031
C00085 00032
C00087 00033
C00089 00034
C00090 00035
C00093 00036
C00096 00037
C00098 00038
C00102 00039
C00106 00040
C00110 ENDMK
C⊗;
;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** HAIRY STATUS FUNCTIONS ******************
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1978 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************

SUBTTL	INTERPRETER FOR STATUS SERIES

STATER:	MOVEI B,(AR2A)
	MOVEI A,(F)
	PUSHJ P,CONS
	FAC [ILLEGAL REQUEST!]

SSTATUS:
	SKIPA F,CQSSTATUS	;FEXPR
STATUS:	MOVEI F,QSTATUS		;FEXPR
	MOVEI AR2A,(A)
	JUMPE A,STATER
	HLRZ A,(A)		;FIRST ARG IS FUNCTION NAME
	PUSHJ P,STLOOK		;LOOK IT UP IN ASCII TABLE
	 JRST STATER
	CAIE F,QSTATUS		;STATUS OR SSTATUS?
	 ADDI R,STBSS-STBS
	ADDI R,STBS
	MOVE D,(R)		;GET TABLE ENTRY
	LSH D,13
	ASH D,-12
	TLO D,1
	HRRI D,(F)
	MOVEM D,SWNACK		;HACK FOR ARGS CHECKING
	MOVEI A,(AR2A)
	MOVEI TT,SWNACK
	JRST FWNACK
;RETURN HERE FROM FWNACK IF ARGS OKAY
STAT1:	HRRZ A,(A)		;CDR ARGS LIST
	HRLI R,410200
	PUSH FXP,R		;BYTE POINTER TO ARGS DESCRIPTORS
	PUSH FXP,R70		;COUNTER FOR ARGS
STAT2:	JUMPE A,STAT6		;JUMP IF NO MORE ARGS
	PUSH P,A
	HLRZ A,(A)		;ELSE GET NEXT ARG
	ILDB T,-1(FXP)		;GET ARG DESCRIPTOR
	JRST .+1(T)
	 JRST STAT6		;0  END OF ARGS
	 JRST STAT3		;1  QUOTED ARG
	 JRST STAT8		;2  QUOTED LIST OF REST
	PUSHJ P,EVAL		;3  EVALUATED ARG
STAT3:	EXCH A,(P)		;LEAVE ARG ON PDL
	HRRZ A,(A)
	SOS T,(FXP)		;COUNT ARGS
	CAML T,XC-4		;NO MORE THAN FOUR ALLOWED
	 JRST STAT2		; (UNLESS IT IS AN LSUBR)
	MOVSI TT,020000		;FOR AN LSUBR, ARRANGE FOR
	ADDB TT,-1(FXP)		; THE LAST ARG SPEC TO BE REUSED
	LDB TT,[410300,,(TT)]	;SEE WHETHER IT'S REALLY AN LSUBR
	CAIE TT,1
	 CAIN TT,3
	  JRST STAT2
STAT6:	POP FXP,T		;-<# OF ARGS>
	POP FXP,F		;RH IS ADDRESS OF TABLE ENTRY
	LDB TT,[410300,,(F)]	;GET STATUS SUBR DISPATCH TYPE
STAT6A:	HRRZ D,(F)
	JRST STAT7(TT)

STAT7:	JSP R,PDLA2(T)		;0  SUBR-TYPE FUNCTION
	JRST (D)		;1  LSUBR-TYPE FUNCTION
	JRST STSCH		;2  SUBR-TYPE WITH CHAR ARG
	JRST STSCH		;3  LSUBR-TYPE WITH CHAR ARG
	JRST STSGVAL		;4  GET LISP VALUE
	JRST STSSVAL		;5  SET LISP VALUE
	JRST STSSTNIL		;6  SET TO T-OR-NIL
	MOVE TT,(D)		;7  GET FIXNUM VALUE
	JRST FIX1

STAT8:	MOVE A,(P)
	SETZM (P)
	JRST STAT3

STSGVAL:	HRRZ A,(D)
CQSSTATUS:	POPJ P,QSSTATUS

STSSVAL:	POP P,A
	JSP T,PDLNMK
STSSV1:	MOVEM A,(D)
	POPJ P,

STSSTNIL:	POP P,A
	PUSHJ P,NOTNOT
	JRST STSSV1

STLOOK:	PUSHJ P,PNGET		;LOOK UP 5 CHARS IN TABLE
	HLRZ A,(A)		;F SAYS WHETHER STATUS OR SSTATUS
	MOVE TT,(A)		;SKIP ON SUCCESS, LEAVING POINTER IN R
	MOVSI R,-LSTBA
	CAIE F,QSTATUS
	 MOVSI R,-LSSTBA
STLK1:	CAMN TT,STBA(R)
	 JRST POPJ1
	AOBJN R,STLK1
	POPJ P,

STSCH:	PUSH FXP,F
	PUSH FXP,T
	ADDI T,1(P)
	HRRZ A,(T)
	JSP T,SPATOM
	 JRST STSCH1
	PUSHJ P,PNGET
	HLRZ A,(A)
	MOVE TT,(A)
	LSH TT,-35
	JSP T,FXCONS
	JRST STSCH2

STSCH1:	PUSHJ P,EVAL
	JSP T,FXNV1
STSCH2:	MOVE T,(FXP)
	ADDI T,1(P)
	HRRM A,(T)
	POP FXP,T
	POP FXP,F
	LDB TT,[410300,,(F)]
	SUBI TT,2
	JRST STAT6A

SUBTTL STATUS FEATURES FEATURE NOFEATURE, SSTATUS, ARRAY

SNOFEATURE:
	PUSH P,CNOT
SFEATURE:
	HRRZ B,FEATURES
	JUMPE A,BRETJ
	HLRZ A,(A)
	PUSHJ P,MEMQ
	JRST NOTNOT

SSFEATURE:
	PUSH P,A
	HRRZ B,FEATURES
	PUSHJ P,MEMQ
	JUMPN A,SSFEA2
	HRRZ A,(P)
	HRRZ B,FEATURES
	PUSHJ P,CONS
SSFEA1:	MOVEM A,FEATURES
SSFEA2:	JRST POPAJ

SSNOFEATURE:
	PUSH P,A
	HRRZ B,FEATURES
	PUSHJ P,.DELQ
	JRST SSFEA1

SSSSLU:	POP P,A
	PUSHJ P,STLOOK
	 JRST FALSE
	JRST TRUE

SSSSS:	SKIPA F,CQSSTATUS
SSSS:	 MOVEI F,QSTATUS
	JUMPN T,SSSSLU
	PUSH P,R70
	CAIN F,QSTATUS
	 SKIPA F,[-LSTBA,,]
	  MOVSI F,-LSSTBA
SSSSS1:	MOVE T,STBA(F)
	MOVEM T,PNBUF
	SETOM LPNF
	MOVEI C,PNBUF
	PUSHJ P,RINTERN
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEM B,(P)
	AOBJN F,SSSSS1
	JRST POPAJ

;STATUS ARRAY RETURNS A LIST OF FOUR NUMBERS:
;  <MIN # OF DIMS> <MAX # OF DIMS> <MIN AXIS LENGTH> <MAX AXIS LENGTH>
;THE LIST IS FRESHLY CONSED ON EACH CALL, AND MAY BE DESTRUCTIVLY MODIFIED
SARRAY:	SETZ B,			;START WITH NIL
	MOVEI TT,777777		;APPROXIMATION OF MAXIMUM AXIS LENGTH
	JSP T,FXCONS
	JSP T,%CONS
	MOVEI B,IN1
	JSP T,%XCONS
	MOVEI B,IN5
	JSP T,%XCONS
	MOVEI B,IN1
	JRST XCONS		;CONS UP FINAL NUMBER THEN RETURN

SUBTTL	STATUS +, STATUS CHTRAN, STATUS SYNTAX


SSPLSS:	MOVEI C,RD8N
	SKIPE A
	 MOVEI C,RD8W
	MOVEM C,RDOBJ8
SPLSS:	MOVE A,RDOBJ8
	SUBI A,RD8N
	JRST NOTNOT

SCHTRAN:
	SKIPA F,[SKIPA TT,(TT)]
SSYNTAX:
NW%	 MOVSI F,(HLRZ TT,(TT))
NW$	 MOVE F,[LDB TT,[113300+TT,,0]]
	PUSH P,CFIX1
	SETZ AR1,		;CROCK
	JRST SSSYN1

SUBTTL	STATUS TTY, SSTATUS TTY

IFE QIO,[
IFN ITS,[

STTY:	.SUSET [.RTTY,,TT]
	JUMPL TT,FALSE		.SEE %TBNOT
	.CALL RTTYS
	 .LOSE 1000
	PUSHJ P,CONS1FX
	MOVE TT,D
	PUSHJ P,CONSFX
	MOVE TT,R
	PUSHJ P,CONSFX
	JRST NREVERSE

SSTTY:	JSP T,FXNV1
	JSP T,FXNV2
	MOVEM TT,STTYS1
	MOVEM D,STTYS2
	JSP T,WAKTTY
	POPJ P,
]		;END OF IFN ITS

IFN D10, STTY==:FALSE
.ALSO	 SSTTY==:FALSE

]		;END OF IFE QIO

IFN QIO,[

;;; (STATUS TTY <FILE>) RETURNS A LIST OF NUMBERS CONCERNING THE TTY:
;;;	FOR ITS:  (<TTYST1> <TTYST2> <TTYSTS>)
;;;	FOR D10:  (<GETLCH WORD> <FILE STATUS>)
;;;	FOR SAIL: (<GETLIN WORD> <FILE STATUS> <SETACT 1> <SETACT 2> <SETACT 3> <SETACT 4>)
;;;	FOR D20:  (<CCOC 1> <CCOC 2> <JFN MODE WORD> <DEFERRED INTERRUPT CHARS MASK>)
;;; RETURNS NIL IF <FILE> IS OMITTED AND THE JOB DOES NOT POSSESS A CONTROLLING TTY.

STTY:	JUMPN T,STTY1
;TEST TO SEE WHETHER WE POSSESS A CONTROLLING TTY
IFN ITS,[
	.SUSET [.RTTY,,TT]	;FOR ITS, SEE IF THIS JOB HAS THE TTY
	JUMPL TT,FALSE		.SEE %TBNOT
]		;END OF IFN ITS
IFN D10,[
IFN SAIL,[
	GETLN D,		;RETURNS ZERO IF JOB IS DETACHED
	 JUMPN D,FALSE
]		;END OF IFN SAIL
IFE SAIL,[
	GETLIN D,		;FOR D10, LH OF GETLIN WORD ZERO
	TLNN D,-1		; MEANS JOB IS DETACHED
	 JRST FALSE
]		;END OF IFE SAIL
]		;END OF IFN D10
IFN D20,[
	LOCKI
	GJINF			;FOURTH RETURNED VALUE IS -1 FOR
	SETZB 1,2		; A DETACHED JOB
	UNLOCKI
	AOJE 4,FALSE
]		;END OF IFN D20
	SKIPA AR1,V%TYI
STTY1:	 POP P,AR1
	PUSHJ P,TFILOK		;SAVES D (FOR SAIL), DOES A LOCKI
	POP FXP,T		;POP THE LOCKI WORD
IFN ITS,[
	.CALL TTYGET		;GET THREE VALUES IN D, R, F
	 .LOSE 1400
	PUSH FXP,D		;TTYST1
	PUSH FXP,R		;TTYST2
	PUSH FXP,F		;TTYSTS
ZZZ==3
]		;END OF IFN ITS
IFN D10,[
	PUSHJ P,D10TNM		;RETURNS APPROPRIATE TERMINAL NUMBER IN D
SA%	GETLCH D
SA$	GETLIN D
	PUSH FXP,D
	SKIPL F.MODE(TT)	.SEE FBT.CM
	 JRST STTY3
	MOVSI R,(SIXBIT \TTY\)	;FOR THE REGULAR TTY,
	SETZB D,F		; OPEN A TEMPORARY CHANNEL
	OPEN TMPC,D		; SO CAN GET THE CHANNEL STATUS
	 HALT
	GETSTS TMPC,D
	RELEASE TMPC,
	JRST STTY4

STTY3:	MOVE R,F.CHAN(TT)	;FOR ANY OTHER TTY, USE THE EXISTING CHANNEL
	LSH R,27
	IOR R,[GETSTS 0,D]
	XCT R
STTY4:	PUSH FXP,D
IFE SAIL, ZZZ==2
IFN SAIL,[
	PUSHN FXP,4
	MOVSI D,-3(FXP)
	SETACT D		;GET FOUR ACTIVATION WORDS
ZZZ==6
]		;END OF IFN SAIL
]		;END OF IFN D10
IFN D20,[
	HRRZ 1,F.JFN(TT)
	RFCOC			;READ CCOC WORDS
	PUSH FXP,2		;CCOC1
	PUSH FXP,3		;CCOC2
	RFMOD			;READ JFN MODE WORD FOR TERMINAL
	PUSH FXP,2
	MOVE 1,[RT%DIM,,.FHSLF]
	RTIW			;READ DEFERRED INTERRUPT WORD
	PUSH FXP,3
	SETZB B,C
ZZZ==4
]		;END OF IFN D20
	PUSH FXP,T		;LOCKI WORD
	UNLOCKI
	PUSHJ P,CONS1PFX
REPEAT ZZZ-2, PUSHJ P,CONSPFX
	JRST CONSPFX
EXPUNGE ZZZ

;;;	IFN QIO

;;; (SSTATUS TTY <NUM1> <NUM2> ... <NUMN> <TTY>) SETS THE
;;; TTY STATUS WORDS FOR <TTY> (WHICH MAY BE OMITTED).
;;; ANY PARAMETERS WHICH ARE OMITTED OR NIL ARE NOT CHANGED.

SSTTY:	HRRZ AR1,(P)		;LSUBR
	CAIN AR1,TRUTH		;LAST ARG T => DEFAULT TTY
	 HRRZ AR1,V%TYI
	JSP TT,XFILEP		;SEE IF LAST ARG IS A TTY
	 SKIPA AR1,V%TYI	;IF NOT, WE USE THE DEFAULT
	  AOSA D,T		;IN ANY CASE, PUT ADJUSTED NUMBER
	   SKIPA D,T		; OR ARGUMENTS IN D
	    POPI P,1		; AND ADJUST THE STACK
	SKIPN F,D		;NO ARGUMENTS MEANS CHANGE NOTHING
	 JRST TRUE
	MOVE R,FXP		;SAVE CURRENT LEVEL OF FXP
SSTTY1:	POP P,A			;FOR EACH ARGUMENT
	SKIPE A			; WE PUSH TWO
	 JSP T,FXNV1		; WORDS ONTO FXP:
	PUSH FXP,TT		; THE FIRST IS THE NUMERIC VALUE, IF ANY,
	PUSH FXP,A		; AND THE SECOND IS ZERO IF THE ARG WAS NIL
	AOJL D,SSTTY1
;BECAUSE THE ARGUMENTS WERE POPPED OFF P IN REVERSE ORDER,
; THEY CAN NOW BE POPPED OFF FXP IN THE CORRECT ORDER.
;F HAS THE NEGATIVE OF THE NUMBER OF ARGUMENTS.
	PUSH P,R		;NOW SAVE OLD FXP ON STACK
	PUSHJ P,TIFLOK		;DOES A LOCKI, SAVES F
	POP FXP,AR2A		;POP LOCKI WORD
IFN ITS,[
	POP FXP,T
	POP FXP,D
	SKIPN T
	 SKIPA D,TI.ST1(TT)	;GET COPY OF THE OLD VALUE IF NOT SETTING NEW
	  MOVEM D,TI.ST1(TT)	;UPDATE TTYST1 WORD
	AOJE F,SSTTY3		;JUMP IF NO MORE ARGUMENTS
	POP FXP,T
	POP FXP,R
	SKIPN T
	 SKIPA R,TI.ST2(TT)
	  MOVEM R,TI.ST2(TT)	;UPDATE TTYST2 WORD
	AOJE F,SSTTY3		;JUMP IF NO MORE ARGUMENTS
	POP FXP,T
	POP FXP,F
	JUMPE T,SSTTY3		;NULL THIRD ARG, THEN NEEDN'T DO HAIRIER CALL
	.CALL TTYSAC		;THREE WORDS ARE IN D, R, F
	 .LOSE 1400
	JRST SSTTY2

SSTTY3:	.CALL TTY2ST		;SET JUST TTYST1, TTYST2
	 .LOSE 1400
]		;END OF IFN ITS
IFN D10,[
	POP FXP,D
	POP FXP,T
	JUMPE D,SSTTY7
IFE SAIL,[
	PUSHJ P,D10TNM
	CAMN D,XC-1
	 GETLCH D
	HRRI T,(D)
	SETLCH T
]		;END OF IFE SAIL
IFN SAIL,[
	SKIPL F.MODE(TT)	.SEE FBT.CM
	 SETLIN T
]		;END OF IFN SAIL
SSTTY7:	AOJE F,SSTTY2
	POP FXP,D
	POP FXP,T
	JUMPE D,SSTTY4		;FOR NULL ARG, FORGET THE FOLLOWING HAIR
	SKIPL F.MODE(TT)	.SEE FBT.CM
	 JRST SSTTY3
	PUSH FXP,F
	MOVSI R,(SIXBIT \TTY\)
	SETZB D,F
	OPEN TMPC,D		;OPEN A TEMP CHANNEL FOR THE TTY
	 HALT
	SETSTS TMPC,T		;SET THE STATUS
	RELEASE TMPC,
	POP FXP,F
	JRST SSTTY4

SSTTY3:	MOVE R,F.CHAN(TT)
	LSH R,27
	IOR R,[SETSTS 0,T]
	XCT R
SSTTY4:
IFN SAIL,[
	AOJE F,SSTTY2		;JUMP IF NO MORE ARGS
IRPC X,,[1234]
	POP FXP,D
	POP FXP,T
	SKIPE D
	 MOVEM T,TI.ST!X(TT)	;UPDATE ACTIVATION WORD X
IFSN X,4, AOJE F,SSTTY5
TERMIN
SSTTY5:	MOVEI T,TI.ST1(TT)
	SETACT T
]		;END OF IFN SAIL
]		;END OF IFN D10
IFN D20,[
	HRRZ 1,F.JFN(TT)	;GET JFN FOR SUBSEQUENT JSYS'S
	POP FXP,D
	POP FXP,T
	SKIPE D,
	 MOVEM T,TI.ST1(TT)	;UPDATE CCOC1
	AOJE F,SSTTY3		;JUMP IF NO MORE ARGUMENTS
	POP FXP,R
	POP FXP,T
	SKIPE R
	 MOVEM T,TI.ST2(TT)	;UPDATE CCOC2
	IOR D,R
SSTTY3:	JUMPE D,SSTTY4		;JUMP IF NO CHANGE TO CCOC'S
	MOVE 2,TI.ST1(TT)
	MOVE 3,TI.ST2(TT)
	SFCOC			;SET CCOC'S
SSTTY4:	AOJGE F,SSTTY2		;JUMP IF NO MORE ARGUMENTS
	POP FXP,D
	POP FXP,2
	SKIPE D
	 SFMOD			;UPDATE JFN MODE WORD
	AOJE F,SSTTY2
	POP FXP,D
	POP FXP,3		;DEFERRED TERMINAL INTERRUPT MASK
	JUMPE D,SSTTY2
	MOVE 1,[ST%DIM,,.FHSLF]
	MOVE 2,[STDTIW]		;STANDARD TERMINAL INTERRUPT WORD
	STIW			;SET TERMINAL INTERRUPT WORDS
]		;END OF IFN D20
SSTTY2:	POP P,FXP		;RESTORE FXP
	PUSH FXP,AR2A		;PUSH BACK LOCKI WORD
20$	SETZB B,C		;CLEAR JUNK OUT OF AC'S
	JRST UNLKTRUE

IFN ITS,[

TTY2ST:	SETZ
	SIXBIT \TTYSET\		;SET TTY VARIABLES
	      ,,F.CHAN(TT)	;CHANNEL #
	      ,,TI.ST1(TT)	;TTYST1
	400000,,TI.ST2(TT)	;TTYST2

TTYSAC:	SETZ
	SIXBIT \TTYSET\		;SET TTY VARIABLES
	      ,,F.CHAN(TT)	;CHANNEL #
	      ,,D		;TTYST1
	      ,,R		;TTYST2
	400000,,F		;TTYSTS

]		;END OF IFN ITS

]		;END OF IFN QIO

IFE QIO,[

SUBTTL	STATUS INTERRUPT, SSTATUS INTERRUPT

;;; ********** TABLE OF USER SET INTERRUPT ACTIONS **********

;;; EACH ENTRY IN THIS TABLE IS THE ADDRESS OF A VALUE CELL
;;; CONTAINING AN INTERRUPT HANDLER (A LISP FUNCTION) TO BE RUN
;;; FOR A GIVEN INTERRUPT. IF A TABLE ENTRY HAS THE 4.9 (SETZ)
;;; BIT ON, THEN WHEN THAT INTERRUPT IS RUN THE NOINTERRUPT FLAG
;;; (UNREAL) WILL BE SAVED AND RESTORED OVER THE EXECUTION OF THE
;;; INTERRUPT FUNCTION (SEE UINT0). THIS IS OF CRITICAL IMPORTANCE
;;; TO REAL-TIME INTERRUPT FUNCTIONS SUCH AS THE ALARMCLOCK HANDLER.

UINTTB:	SETZ VCN.AT		;0.	↑@ TTY INTERRUPT
Q%	SETZ VCN.H		;1.	↑H TTY INTERRUPT (↑H BREAK)
Q$	SETZ VCN.B		;1.	↑B TTY INTERRUPT (↑B BREAK)
	SETZ VICA		;2.	↑A TTY INTERRUPT
	SETZ VALARMCLOCK	;3.	REAL/RUN TIME CLOCK
	VERRSET			;4.	ERRSET FUNCTION
ERSTBK==.-UINTTB-1		;INDEX FOR ERRSET BREAKOUT INTERRUPT
	VUDF			;5.	UNDF-FNCTN BREAK
	VUBV			;6.	UNBND-VRBL BREAK
	VWTA			;7.	WRNG-TYPE-ARG BREAK
	VUGT			;8.	UNSEEN-GO-TAG BREAK
	VWNA			;9.	WRNG-NO-ARGS BREAK
	VGCL			;10.	GC-LOSSAGE BREAK
	VFAC			;11.	FAIL-ACT BREAK
NUIE==.-UINTTB-1-ERSTBK	;# OF CORRECTABLE USER INTERRUPTION ERRORS
	VPDL			;12.	PDL-OVERFLOW BREAK
	VGCO			;13.	GC-OVERFLOW BREAK
	SETZ VIC34		;14.	↑\ TTY INTERRUPT
	SETZ VIC35		;15.[	↑] TTY INTERRUPT (BEWARE: BRACKETS!)
	SETZ VIC36		;16.	↑↑ TTY INTERRUPT
Q%	VNIL			;17.	(RESERVED FOR FUTURE USE)
Q$	VIOL			;17.	IO-LOSSAGE BREAK
Q$ NUIE==.-UINTTB-1-ERSTBK	;# OF CORRECTABLE USER INTERRUPTION ERRORS
	VAUTFN			;18.	AUTOLOAD INTERRUPT HANDLER
	V.TRAP			;19.	*RSET HANDLER FOR RETURNING FROM ERROR
	VGCDAEMON		;20.	GC-DAEMON (RUN AFTER EVERY GC)
LUINTTB==.-UINTTB


SSINTERRUPT:	PUSHJ P,SINTERRUPT
	HRRM B,@UINTTB(TT)
	JRST BRETJ


SINT0:	WTA [BAD INTERRUPT ## - STATUS!]
SINTERRUPT:
	JSP T,FXNV1
	JUMPL TT,SINT0
	CAIN TT,LUINTTB
	JRST SINT0
	HRRZ AR1,UINTTB(TT)
	CAIN AR1,VNIL
	JRST SINT0	
	HRRZ A,(AR1)
	POPJ P,

]		;END OF IFE QIO

SFRET:	CAIN B,QBPS		;FIGURE OUT SPACE TYPE
	 JRST 1(R)		;BPS => SKIP 1
	CAIN B,QRANDOM		;BAD SPACE TYPE => SKIP 0
	 JRST (R)		;LIST, FIXNUM, FLONUM, BIGNUM,
	CAIN B,QARRAY		; SYMBOL, SAR => SKIP 2
	 MOVEI B,QRANDOM
	CAIL B,QLIST
	 CAILE B,QRANDOM
	  JRST (R)
   2DIF [HRREI TT,(B)]-NFF,QLIST
	JRST 2(R)

SUBTTL STATUS UUOLI, SSTATUS UUOLI, STATUS IOC, STATUS CLI, SSTATUS CLI

SUUOLINKS:
IFN D10,[
	SKIPN T,LDXSIZ
	 JRST FALSE		;RETURN NIL IF NO XCT HACKERY HAS BEEN DONE
	SETZB TT,D		;ZERO COUNTER
	TLNE T,400000
	 MOVEI D,TRUTH		;D GETS TRUE IF PURIFIED
	MOVNS T			;MAKE UP AOBJN POINTER FOR XCT CALL AREA 2
	HLL T,LDXBLT
	MOVSS T
SUUOL1:	SKIPN (T)		;COUNT FREE CELLS IN XCT CALL AREA
	 AOS TT
	AOBJN T,SUUOL1
	JSP T,FIX1A	;RETURN LIST OF PURE FLAG AND COUNT
	PUSHJ P,NCONS
	MOVE B,D
	JRST XCONS
]		;END IFN D10
IFN ITS+D20,[
	SKIPN LDXPNT		;IF NO XCT PAGES
	 JRST FALSE		; RETURN FALSE
	MOVN TT,LDXLPC		;GET NUMBER OF FREE SLOTS IN LAST SEGMENT
	JSP T,FIX1A
	PUSHJ P,NCONS
	MOVEI B,NIL
	SKIPE LDXPFG		;PURIFIED?
	 MOVEI B,TRUTH
	JRST XCONS
]		;END IFN ITS+D20

SSUUOLINKS:
IFN D10,[
	SKIPN TT,LDXBLT		;ZAP CALLS FOR XCTS WITH A BLT
	JRST FALSE
	MOVEI T,(TT)
	ADD T,LDXSM1
	BLT TT,(T)
	JRST TRUE
]		;END IFN D10
IFN ITS+D20,[
	SKIPN T,LDXPNT		;LOOP OVER ALL XCT SEGMENTS
	 JRST FALSE
SSUUL1:	JUMPE T,TRUE		;RETURN TRUE WHEN DONE
	HRRZI TT,LDXOFS(T)	;TARGET ADR
	HRL TT,LDXPSP(T)	;ADR-OFFSET TO GET DATA FROM
	ADD TT,[LDXOFS,,0]	;MAKE INTO SOURCE ADR
	BLT TT,SEGSIZ-1(T)	;RECOPY LINK AREA
	HLRZ T,LDXPSP(T)	;LINK TO NEXT PAGE
	JRST SSUUL1
]		;END IFN ITS+D20

IFN USELESS*ITS,[
SCLI:	MOVEI T,%PICLI		;TEST TO SEE IF THIS BIT IS ON (IN IMASK)
	TDNN T,IMASK		;IF ON, RETURN T, ELSE RETURN NIL
	 JRST FALSE
	JRST TRUE

SSCLI:	MOVEI T,%PICLI
	MOVEI TT,IMASK
	SKIPN A			;ON OR OFF?
	 TLOA TT,(ANDCAM T,)	;OFF, USE ANDCAM
	  HRLI TT,(IORM T,)	;ON, USE IORM
	XCT TT			;MODIFY LISP'S MASK
	SKIPN A
	 TLOA T,(TRZ)
	  TLO T,(TRO)
	.CALL CLIVAR
	 .LOSE 1400		;BAD NEWS....
	JUMPN A,TRUE
	POPJ P,

CLIVAR:	SETZ
	SIXBIT \USRVAR\
	MOVEI %JSELF
	MOVEI .RMASK
	MOVEI
	SETZ T
]		;END IFN USELESS*ITS

IFE QIO,[

SIOC:	JSP T,FXNV1
	MOVSI AR2A,-LSIOCT
SIOC1:	MOVE AR1,SIOCT(AR2A)
	CAIN TT,(AR1)
	JRST SIOC2
	AOBJN AR2A,SIOC2
	MOVEI A,(B)
	WTA [BAD CHARACTER - STATUS IOC!]
	MOVEI B,(A)
	JRST SIOC

SIOC2:	MOVSS AR1
	HRRZ A,(AR1)
	CAIL AR2A,SIOCTI
	JRST NOT
	JRST NOTNOT

SIOCT:
IRPS A,,[SIGNAL,LPTON,GCGAGV,TAPRED,TAPWRT,TTYOFF]B,,[A,B,D,Q,R,W]
	A,,"B
TERMIN
IFN MOBIOF,	IPLOPD,,"P
IFN MOBIOF,[
	DISON,,"F
	DISPON,,"N
]
SIOCTI==.-SIOCT
IRPS A,,[LPTON,GCGAGV,TAPRED,TAPWRT,TTYOFF]B,,[E,C,S,T,V]
	A,,"B
TERMIN
IFN MOBIOF,	IPLOPD,,"U
IFN MOBIOF, DISPON,,"Y
LSIOCT==.-SIOCT



SUREAD:	SKIPE A,UTIOPD
	JRST SURD1
	POPJ P,

SUWRITE:
	SKIPE A,UTOOPD
	MOVE A,UWUNIT
	POPJ P,
]		;END OF IFE QIO

SUBTTL	STATUS TIME, DATE, UNAME, USERID, JNAME, JNUMBER, SUBSYSTEM

IFN ITS,[

STIME:	.RTIME TT,
	JRST SDATE+1

SDATE:	.RDATE TT,
	AOJE TT,FALSE
	MOVE D,TT
	SUB D,[202020202021]	;21 ADJUSTS FOR THE AOJE
	JSP F,STCVT
	JSP F,STCVT
	JSP F,STCVT
	MOVNI T,3
	JRST LIST

STCVT:	SETZB TT,R
	LSHC TT,6
	IMULI TT,10.
	ROTC D,6
	ADD TT,R
	JSP T,FXCONS
	PUSH P,A
	JRST (F)

SUNAME:	.SUSET [.RUNAME,,TT]
	JRST SIXATM

SUSERID:
	.SUSET [.RXUNAME,,TT]
	JRST SIXATM

SJNAME:	.SUSET [.RJNAME,,TT]
	JRST SIXATM

SSUBSYSTEM:
	.SUSET [.RXJNAME,,TT]
	JRST SIXATM

SJNUMBER:
	.SUSET [.RUIND,,TT]
	JRST FIX1

SHOMEDIR:
	.SUSET [.RHSNAME,,TT]
	JRST SIXATM

SHSNAME:			;NEW HAIRY READ HSNAME
	JUMPE T,SHOMEDIR	;NO ARGS, SAME AS (STATUS HOMEDIR)
	PUSH FXP,T		;SAVE NUMBER OF ARGS OVER SUPERIOR CHECK
	JSP T,SIDDTP		;IS THERE A DDT ABOVE US?
	 JRST SHSNA2		;NOPE...
	POP FXP,T
	SETZ TT,		;ASSUME NULL ITS NAME
	AOJE T,SHSNA1		;ITS ARG GIVEN?
	POP P,A			;YES, GET THE ITS NAME
	PUSHJ P,SIXMAK		;GET SIXBIT INTO TT
SHSNA1:	PUSH FXP,TT		;SAVE THE ITS NAME
	POP P,A
	PUSHJ P,SIXMAK		;CONVERT UNAME TO SIXBIT
	PUSH FXP,TT		;STORE THAT ON FXP ALSO
	MOVEI TT,-1(FXP)	;POINTER TO FIRST WORD
	HRLI TT,..RHSNAME	;FOR .BREAK 12,
	.BREAK 12,TT		;READ THE HSNAME FROM DDT
	POP FXP,TT		;NOW CONVERT TO AN ATOM
	PUSHJ P,SIXATM
	POPI FXP,1		;REMOVE EXTRA WORD FROM STACK
	POPJ P,			;THEN RETURN
SHSNA2:	POP FXP,T		;RESTORE NUMBER OF ARGS
	MOVNS T
	SUB P,R70(T)		;REMOVE THE APPROPRIATE NUMBER OF WORDS FROM P
	SETZ A,			;RETURN NIL
	POPJ P,
]	;END OF IFN ITS

IFE ITS,[
SHSNAME:			;HSNAME IS SIMPLY HOMEDIR
	MOVNS T
	SUB P,R70(T)		;REMOVE THE APPROPRIATE NUMBER OF WORDS FROM P
	MOVE A,SUDIR
	POPJ P,
]	;END IFE ITS
IFN D10,[
IFE SAIL,[
SDATE:	MOVE R,[%CNYER]
	MOVE D,[%CNMON]
	MOVE TT,[%CNDAY]
	GETTAB R,
	 JRST FALSE
	SUBI R,1900.
	JRST STIM2

STIME:	MOVE R,[%CNHOR]
	MOVE D,[%CNMIN]
	MOVE TT,[%CNSEC]
	GETTAB R,
	 JRST FALSE
STIM2:	GETTAB D,
	 JRST FALSE
	GETTAB TT,
	 JRST FALSE
	PUSHJ P,CONS1FX
	MOVE TT,D
	PUSHJ P,CONSFX
	MOVE TT,R
	JRST CONSFX

SSUBSYSTEM:
	HRROI TT,.GTPRG		;GET PROGRAM NAME FOR MYSELF
	GETTAB TT,
	 JRST FALSE
	JRST SIXATM
]		;END OF IFE SAIL
IFN SAIL,[
SDATE:	DATE D,			;DATE IN D = <<YEAR-1964.>*12.+MONTH-1>*31.+DAY-1
	IDIVI D,31.		;REMAINDER IN R IS DAYS-1
	AOJ R,
	MOVE T,R
	IDIVI D,12.		;REMAINDER HERE IS MONTH-1
	AOJ R,
	ADDI D,64.		;QUOTIENT IN D IS YEAR-1964.
	PUSH FXP,D
	PUSH FXP,R
	PUSH FXP,T
	JRST STIM2

STIME:	TIMER TT,		;GET TIME IN TT
	IDIVI TT,60.		;REDUCE TO SECONDS
	IDIVI TT,60.		;NOW GET SECONDS AS A REMAINDER
	MOVE R,D
	IDIVI TT,60.		;REMAINDER IS MINUTES
	PUSH FXP,TT
	PUSH FXP,D		;REST IS HOURS
	PUSH FXP,R
STIM2:	PUSHJ P,CONS1PFX	;START A LIST WITH NUMBER ON FXP
	PUSHJ P,CONSPFX		;ADD FIXNUM TO LIST
	JRST CONSPFX		;ADD THIRD FIXNUM TO LIST

SSUBSYSTEM:
	SETO TT,
	GETNAM TT,		;GET (GENERIC?) NAME OF JOB
	JRST SIXATM
]		;END OF IFN SAIL

SJNAME:	MOVE TT,D10NAM
	JRST SIXATM

SJNUMBER:	PJOB TT,	;GET JOB NUMBER
	JRST FIX1

SUSERID:
IFE SAIL,[
	HRROI TT,.GTNM1		;GET USER NAME FOR THIS JOB
	GETTAB TT,
	 JRST SUNAME
	HRROI D,.GTNM2
	GETTAB D,
	 HALT			;HOW CAN THIS LOSE?
	JUMPE TT,SUNAME
	SETOM LPNF		;CONVERT TWO WORDS OF SIXBIT
	MOVE C,PNBP		; TO ASCII IN PNBUF
SUSER1:	LDB T,[360600,,TT]
	ADDI T,40
	IDPB T,C
	LSHC TT,6
	JUMPN TT,SUSER1
	PUSHJ FXP,RDAEND
	JRST RINTERN		;MAKE IT AN ATOMIC SYMBOL
]		;END OF IFE SAIL
SUNAME:
Q%	GETPPN D,
Q$	GETPPN TT,		;PPNATM EXPECTS PPN IN TT
	JFCL
Q$	JRST PPNATM
IFE QIO,[
IFE SAIL,[
SUNM2:	HRRZ TT,D
	PUSHJ P,CONS1FX
	HLRZ TT,D
	JRST CONSFX
]	;END OF IFE SAIL
IFN SAIL,[
SUNM2:	HRLZM D,UNMTMP		;PROG IN UNMTMP
	MOVE A,[440600,,UNMTMP] ;BYTE PTR FOR UNAME
	MOVEM A,UNMTMP+1	;SAVE BYTE PTR HERE FOR SAILFN HACK
	PUSHJ P,SAILFN		;TO LOCAL HACK.
	MOVE A,UNMTMP+1		;GRAB NEW PTR BACK FOR READ6C
	SETZM UNMTMP+1		;NEXT WORD ZEROS
	PUSH FXP,D
	PUSHJ P,READ6C		;USE READER TO MAKE ATOM AND INTERN IT
	PUSHJ P,NCONS		;(LIST PROG)
	POP FXP,D
	PUSH FXP,A		;SAVE ON STACK
	HLLZM D,UNMTMP		;PROJ IN UNMTMP
	MOVE A,[440600,,UNMTMP] ;BYTE PTR FOR UNAME
	MOVEM A,UNMTMP+1	;SAVE BYTE PTR HERE FOR SAILFN HACK
	PUSHJ P,SAILFN		;TO LOCAL HACK.
	MOVE A,UNMTMP+1		;GRAB NEW PTR BACK FOR READ6C
	SETZM UNMTMP+1		;NEXT WORD ZEROS
	PUSHJ P,READ6C		;INTERN IT
	POP FXP,B		;(LIST PROG) IN B
	JRST CONS		;(CONS PROJ (LIST PROG)))

SAILFN: MOVE T,UNMTMP+1		;GRAB BYTE PTR
	ILDB A,T		;INCREMENT AND LOAD IT
	CAIE A,0  		;IS IT NULL?
	POPJ P,			;NO, SO WIN
	IBP UNMTMP+1		;OTHER POINTER
	JRST SAILFN+1		;AGAIN

]		;END OF IFN SAIL
]		;END OF IFE QIO

]		;END OF IFN D10

IFN D20,[

STIME:	PUSHJ P,SDATIM		;RETURNS TIME IN F
	MOVEI TT,(F)
	IDIVI TT,60.		;REMAINDER IS SECONDS
	MOVE R,D
	IDIVI TT,60.		;THIS YIELDS HOURS AND MINUTES
	EXCH TT,R
STIME1:	PUSHJ P,CONS1FX		;CONS R, D, TT INTO A LIST OF FIXNUMS
	MOVE TT,D
	PUSHJ P,CONSFX
	MOVE TT,R
	JRST CONSFX

SDATE:	PUSHJ P,SDATIM		;RETURNS DATE IN D AND R
	HLRZ TT,R		;DAY-1
	HLRZ R,D		;YEAR
	SUBI R,1900.		;REDUCE IT TO A YEAR MOD 100.
	MOVEI D,1(D)		;MONTH
	AOJA TT,STIME1		;INCREMENT DAY-1 TO DAY, AND GO CONS

SDATIM:	LOCKI			;PREVENT JUNK IN AC'S FROM CAUSING TROUBLE
	SETO 2,			;CURRENT TIME
	SETZ 4,
	ODCNV			;GET TIME AND DATE INFORMATION
	MOVE D,2		;RETURN INFORMATION IN D, R, F
	MOVE R,3
	MOVE F,4
	SETZB 1,2		;PREVENT TROUBLE AFTER UNLOCKI
	SETZB 3,4
	UNLKPOPJ

SJNAME:				;?
SSUBSYSTEM:
	LOCKI
	GETNM			;GET PROGRAM NAME
	MOVE TT,1
	SETZ 1,
	UNLOCKI
	JRST SIXATM

SUSERID:			;?
SUNAME:	LOCKI
	MOVE TT,[PNBUF,,PNBUF+1]
	SETZM PNBUF		;CLEAR PNBUF
	BLT TT,PNBUF+LPNBUF-1
	GJINF			;GET JOB INFORMATION
	MOVE 2,1		;1 HAS LOGIN DIRECTORY NUMBER
	MOVE 1,PNBP
	DIRST			;GET EQUIVALENT ASCII STRING
	 HALT			;BETTER NOT FAIL...
	SETZB 1,2
	UNLOCKI
	JRST PNBFAT		;MAKE ASCII STRING AN ATOM

SJNUMBER:
	LOCKI
	GJINF			;GET JOB INFORMATION
	MOVE TT,3		;JOB NUMBER
	SETZB 1,2
	UNLOCKI
	JRST FIX1

]		;END OF IFN D20

SUBTTL	STATUS LINMODE

IFE QIO,[
IFN ITS,[

ZZX==<%TG<ACT>>*010101010101		;6 %TGACT BITS
SSLINMODE:
	SKIPN A
	SKIPA T,[STTYW1&ZZX]
	SKIPA T,[STTYL1&ZZX]
	SKIPA TT,[STTYW2&ZZX]
	SKIPA TT,[STTYL2&ZZX]
	TDZA A,A
	MOVEI A,TRUTH
	MOVEM A,LINMODE
	MOVE D,[ZZX]
	ANDCAM D,STTYS1
   XCTPRO
	ANDCAM D,STTYS2
	IORM T,STTYS1		;CLOBBER IN ONLY ACTIVATION BITS
	IORM TT,STTYS2
   NOPRO
	JSP T,WAKTTY
	POPJ P,

]		;END OF IFN ITS
]		;END OF IFE QIO

IFN QIO,[

SSLINMODE:
	CAMN T,XC-1
	 SKIPA AR1,V%TYI
	  POP P,AR1
	POP P,A
	PUSHJ P,TIFLOK		;DOES A LOCKI
	MOVE T,F.MODE(TT)
	SKIPN A
IFN ITS,[
ZZX==<%TG<ACT>>*010101010101		;6 %TGACT BITS
	 SKIPA R,[STTYW1&ZZ]		;PUT APPROPRIATE ACTIVATION
	  SKIPA R,[STTYL1&ZZX]		; BITS IN R AND F
	   SKIPA F,[STTYW2&ZZX]
	    SKIPA F,[STTYL2&ZZX]
]		;END OF IFN ITS
IFN SAIL,[
	 SKIPA D,[[SACTW1 ? SACTW2 ? SACTW3 ? SACTW4],,]
	  SKIPA D,[[SACTL1 ? SACTL2 ? SACTL3 ? SACTL4],,]
]		;END OF IFN SAIL
	     TLZA T,FBT.LN
	      TLO T,FBT.LN
	MOVEM T,F.MODE(TT)
IFN ITS,[
	MOVE D,[ZZX]
	ANDCAM D,TI.ST1(TT)
	IORM R,TI.ST1(TT)	;CLOBBER IN ONLY ACTIVATION BITS
	ANDCAM D,TI.ST2(TT)
	IORM F,TI.ST2(TT)
EXPUNGE ZZX
]		;END OF IFN ITS
IFN SAIL,[
	HRRI D,TI.ST1(TT)
	BLT D,TI.ST4(TT)	;UPDATE STATUS WORDS
	MOVEI T,TI.ST1(TT)
	SETACT T		;TELL THE SYSTEM ABOUT IT
]		;END OF IFN SAIL
	UNLOCKI
	JRST NOTNOT

]		;END OF IFN QIO

SUBTTL	STATUS DOW

IFN USELESS,[
IFN ITS,[

SDOW:	.RYEAR TT,
	AOJE TT,FALSE
	LSH TT,-31
	ANDI TT,16
	MOVE T,SDOWQX(TT)
	MOVEM T,PNBUF
	MOVE T,SDOWQX+1(TT)
	MOVEM T,PNBUF+1
Q%	MOVEI C,PNBUF+1
Q%	SETOM LPNF
Q%	JRST RINTERN
Q$	JRST PNBFAT

SDOWQX:
IRP DAY,,[SUNDAY,MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY]
	ASCII \DAY\
TERMIN

]		;END OF IFN ITS

IFN D10,[

SDOW:
IFE SAIL,[
	MOVE T,[%CNDTM]		;INTERNAL FORMAT DATE,,TIME
	GETTAB T,
	 JRST FALSE
	HLRZS T
]		;END OF IFE SAIL
IFN SAIL,[
	DATE T,			;DATE IN T
	DAYCNT T,		;CONVERT TO NUMBER OF DAYS
]				;END OF IFN SAIL
;T NOW HAS NUMBER OF DAYS SINCE 1-JAN-64 (A WEDNESDAY)
	IDIVI T,7
	LSH TT,1
	MOVE T,SDOWQX(TT)
	MOVEM T,PNBUF
	MOVE T,SDOWQX+1(TT)
	MOVEM T,PNBUF+1
Q%	MOVEI C,PNBUF+1
Q%	SETOM LPNF
Q%	JRST RINTERN
Q$	JRST PNBFAT

SDOWQX:				;FUNNY ORDER FOR DEC-10
IRP DAY,,[WEDNESDAY,THURSDAY,FRIDAY,SATURDAY,SUNDAY,MONDAY,TUESDAY]
	ASCII \DAY\
TERMIN
]		;END OF IFN D10

IFN D20,[

SDOW:	PUSHJ P,SDATIM		;RH OF R GETS DAY OF WEEK (0 = MONDAY)
	LSH R,1
	MOVE T,SDOWQX(R)
	MOVEM T,PNBUF
	MOVE T,SDOWQX+1(R)
	MOVEM T,PNBUF+1
	JRST PNBFAT

SDOWQX:				;FUNNY ORDER FOR DEC-10
IRP DAY,,[MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY,SUNDAY]
	ASCII \DAY\
TERMIN
]		;END OF IFN D20

]		;END OF IFN USELESS

SUBTTL	STATUS ABBREVIATE, STATUS MEMFREE


IFN USELESS,[
SABBREVIATE:
	MOVEI TT,LRCT-2
	HRRZ A,VREADTABLE
	HRRZ TT,@TTSAR(A)
	JRST FIX1

SSABBREVIATE:
	SKIPN TT,A
	 JRST SSABB1
	MOVEI TT,3
	CAIE A,TRUTH
	 JSP T,FXNV1
SSABB1:	MOVEI T,(TT)
	MOVEI TT,LRCT-2
	HRRZ B,VREADTABLE
	HRRM T,@TTSAR(B)
	JRST PDLNKJ
]		;END OF IFN USELESS



SMEMFREE:
10%	MOVE TT,HINXM	;NUMBER OF WORDS IN HOLE
10%	SUB TT,BPSH	;INTERRUPT HERE WOULD SCREW,
10$	MOVE TT,MAXNXM
10$	SUB TT,HIXM
	JRST FIX1	; WORRY, WORRY, WHO CARES

SUBTTL	STATUS SYSTEM
	
SSYST0:	WTA [SYMBOL REQUIRED - STATUS SYSTEM!]
SSYSTEM:			;(STATUS SYSTEM) ENTRY-POINT
	JSP T,SPATOM
	 JRST SSYST0
	JUMPE A,SSYST6
	CAIN A,TRUTH
	 JRST SSYST6
	MOVEI AR1,NIL
	MOVEI B,QSYMBOL		;CHECK FOR SYMBOL HEADER IN SYSTEM SPACE
	CAIL A,SYMSYF
	 CAILE A,SYMSYL
	  JRST SSYST7		;NOT IN RANGE, CONTINUE CHECKING
	EXCH A,AR1
	PUSHJ P,XCONS
	EXCH A,AR1
SSYST7:	MOVEI B,QVALUE
	HLRZ C,(A)
	HRRZ C,(C)
	CAIGE C,ESYSVC
	 JRST SSYST4
SSYST1:	MOVEI B,SSSBRL
	PUSHJ P,GETLA
	JUMPE A,AR1RETJ
	HLRZ B,(A)
	HRRZ A,(A)
	HLRZ C,(A)
	CAIE B,QAUTOLOAD
	JRST SSYST3
	CAIL C,BSYSAP		;IS IT A SYSTEM AUTOLOAD PROP?
	 CAIL C,ESYSAP
	  JRST SSYST1	;NOPE
	JRST SSYST4	;YUP
SSYST3:	CAIE B,QARRAY
	JRST SSYST5
	CAIL C,BSYSAR		;IS IT A SYSTEM ARRAY
	 CAIL C,ESYSAR
	  JRST SSYST1
	JRST SSYST4
SSYST5:	CAIL C,ENDFUN		;SUBR OR VC ADDRESS IN SYSTEM AREA
	 JRST SSYST1
SSYST4:	EXCH A,AR1		;A WIN, SO CONS UP THIS PROPERTY NAME
	PUSHJ P,XCONS
	EXCH A,AR1
	JRST SSYST1

SSYST6:	MOVEI A,QVALUE
	PUSHJ P,NCONS
	MOVEI B,QSYMBOL
	JRST XCONS

SUBTTL	STATUS GCTIME, LISPVERSION, TTYREAD, ←, TERPRI

SSGCTIM:
	JSP T,FXNV1
IT$	LSH TT,-2
10$	IDIVI TT,1000.
20$	IDIVI TT,1000.
	EXCH TT,GCTIM
	JRST SGCTM1

SGCTIM:	MOVE TT,GCTIM
SGCTM1:	PUSH P,CFIX1		;FAKE OUT ENTRY INTO RUNTIME
	JRST RNTM1

SLVRNO:	MOVE A,[440600,,[LVRNO]]
	JRST READ6C

IFE QIO,[
STERPRI:
	MOVEI TT,LRCT-1
	JRST SLAP1
]		;END OF IFE QIO

STTYREAD:	SKIPA TT,[LRCT-2]
SLAP:	HRROI TT,LRCT-1
SLAP1:	HRRZ A,VREADTABLE
	MOVE A,@TTSAR(A)
	SKIPL TT
	MOVSS A
	JRST RHAPJ

IFE QIO,[
SSTERPRI:
	MOVEI R,LRCT-1
	JRST SSLAP1
]		;END OF IFE QIO

SSTTYREAD:	SKIPA R,[LRCT-2]
SSLAP:	HRROI R,LRCT-1
SSLAP1:	PUSHJ P,NOTNOT
	HRRZ D,VREADTABLE	;INTERRUPT COULD SCREW HERE (FOO)
	JSP T,.STOR0
	POPJ P,

IFN QIO,[
SLINMODE:	MOVSI F,FBT<LN>
	SKIPN T
	 SKIPA AR1,V%TYI
	  POP P,AR1
	PUSHJ P,TIFLOK
	TDNN F,F.MODE(TT)
	 TDZA A,A
	  MOVEI A,TRUTH
	UNLKPOPJ


STERPRI:
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
STERP1:	SKIPLE FO.LNL(TT)
	 TDZA A,A
	  MOVEI A,TRUTH
	UNLKPOPJ

SSTERPRI:
	CAMN T,XC-1
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
	POP P,A
	MOVMS FO.LNL(TT)
	SKIPE A
	 MOVNS FO.LNL(TT)
	JRST STERP1
]		;END OF IFN QIO

SUBTTL	STATUS CRFILE, LOSEF

IFN QIO,[
SCRFUN==FALSE		;***** TEMP CROCK *****

SCRFIL:	SETZ A,
	PUSHJ P,DEFAULTF
	HRRZ A,(A)
	POPJ P,
]		;END OF IFN QIO


IFE QIO,[
SSCRFIL:
	PUSH P,A
	PUSHJ P,UFNAME
	JRST POPAJ

SCRFIL:	PUSH P,[440600,,UFN1]
	MOVE A,[440600,,UFN2]
	PUSHJ P,READ6C
	PUSHJ P,NCONS
	JRST SCRFL1

SURD1:	PUSH P,[440600,,URFN1]
	MOVE A,[440600,,URFN2]
	PUSHJ P,READ6C
	MOVE B,URUNIT
	PUSHJ P,CONS
SCRFL1:	EXCH A,(P)
	PUSHJ P,READ6C
	POP P,B
	JRST CONS

SCRFUN:	PUSHJ P,SCRFIL
	MOVE B,IUNIT
	JRST .NCONC
]		;END OF IFE QIO

SLOSEF:	MOVE T,LOSEF
	JFFO T,.+1
	MOVNS TT
	ADDI TT,36.
	JRST FIX1

SSLOS0:	MOVEI A,(B)
	WTA [BAD LOSEF - SSTATUS!]
SSLOSEF:
	MOVEI B,(A)
	SKIPE GCPSAR
	JRST SLOSEF
	JSP T,FXNV2
	JUMPLE D,SSLOS0
	CAILE D,16
	JRST SSLOS0
	MOVEI TT,1
	LSH TT,(D)
	SUBI TT,1
	MOVEM TT,LOSEF
BPDLNKJ:	MOVEI A,(B)
	JRST PDLNKJ

SUBTTL	STATUS JCL, HACTRN

IFN D10,[
SJCL:	SKIPN T,SJCLBUF
	JRST FALSE
	PUSH FXP,T
	PUSH FXP,[440700,,SJCLBUF+1]
SJCL2:	ILDB TT,(FXP)
	PUSHJ P,RDCH2
	PUSH P,A
	SOSLE -1(FXP)
	JRST SJCL2
SJCL4:	MOVE T,SJCLBUF
	SUB FXP,R70+2
	JRST LIST
]		;END OF IFN D10

IFN ITS,[
SDDTP:	.SUSET [.RSUPPRO,,TT]	;STATUS HACTRN
	JUMPL TT,FALSE		;NIL MEANS NO SUPERIOR
	MOVEI A,TRUTH		;T MEANS THE UNKNOWN SUPERIOR
	.SUSET [.ROPTION,,TT]
	TLNE TT,OPTDDT
	 MOVEI A,QDDT
	TLNE TT,OPTLSP
	 MOVEI A,QLISP
	POPJ P,

SJCL:	.SUSET [.ROPTION,,TT]
	TLNE TT,OPTBRK
	TLNN TT,OPTCMD
	 JRST FALSE		;EXIT WITH NIL IF NO COMMAND LINE
	SETZM JCLBF
	MOVE T,[JCLBF,,JCLBF+1]
	BLT T,JCLBF+LJCLBF-1
	HLLOS JCLBF+LJCLBF-1
	.BREAK 12,[..RJCL,,JCLBF]
	MOVEI T,JCLBF		;MUST CLEAR BIT 35'S AS DDT MAY SET THEM!!
	MOVEI TT,1		;MASK
SJCL1A:	ANDCAM TT,(T)		;TURN OFF BIT 35
	CAIGE T,JCLBF+LJCLBF-1	;DO ALL WORDS IN JCLBF
	 AOJA T,SJCL1A
	PUSH FXP,R70
	PUSH FXP,[440700,,JCLBF]
SJCL1:	ILDB TT,(FXP)
	JUMPE TT,SJCL3
SJCL2:	PUSH P,TT
	PUSHJ P,RDCH2
	EXCH A,(P)
	SOS -1(FXP)
	CAIE A,↑M	;CAR-RET CAUSES TERMINATION
	JRST SJCL1
SJCL4:	MOVE T,-1(FXP)
	SUB FXP,R70+2
	JRST LIST

SJCL3:	HRRZ T,(FXP)
	CAIE T,JCLBF+LJCLBF-1
	JRST SJCL4
	MOVEI A,QSJCL
	FAC [TOO MUCH JCL - STATUS!]
]		;END OF IFN ITS

SUBTTL	STATUS TTYSIZE, TTYTYPE, NEWIO OSPEED

IFN ITS,[

IFE QIO,[
STTYSIZE:			;RETURNS (TTYHEIGHT . TTYWIDTH)
	.CALL RSSBLK		;GET WIDTH IN TT, HEIGHT IN D
	 .VALUE
	JSP T,FXCONS
	MOVEI B,(A)
	MOVE TT,D
	JRST CONSFX
]		;END OF IFE QIO

IFN QIO,[
STTYTYPE:
	TDZA F,F
STTYSIZE:
	 MOVEI F,1
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
	.CALL STTSZ9
	 .VALUE
	UNLOCKI
	JUMPN F,STTYS1
	MOVE TT,R
	JRST FIX1

STTYS1:	JSP T,FXCONS
	MOVEI B,(A)
	MOVE TT,D
	JRST CONSFX

STTSZ9:	SETZ
	SIXBIT \CNSGET\		;GET CONSOLE PARAMETERS
	      ,,F.CHAN(TT)	;CHANNEL #
	  2000,,D		;VERTICAL SCREEN SIZE
	  2000,,TT		;HORIZONTAL SCREEN SIZE
	402000,,R		;TCTYP
;TTYCOM, TTYOPT, TTYTYP NOT RETRIEVED

;OSPEED - RETURNS TTY OUPUT SPEED VARIABLE
SOSPEED:
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
	.CALL SOSSP9
	 .VALUE
	UNLOCKI
	JRST FIX1
SOSSP9:	SETZ
	SIXBIT \TTYVAR\
	      ,,F.CHAN(TT)
	      ,,[SIXBIT \OSPEED\]
	402000,,TT	

]		;END OF IFN QIO

]		;END OF IFN ITS

IFN D10,[
IFN QIO,[
STTYTYPE:
IFE SAIL,[
	SKIPE T
	 POPI P,1
	JRST 0POPJ		;ALWAYS ZERO (?)
]		;END OF IFE SAIL
IFN SAIL,[
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
	PUSHJ P,D10TNM		;GET TTY NUMBER IN D
	GETLIN D		;GET LINE CHARACTERISTICS
	UNLOCKI
	HLRZ T,D
	TRZ T,150777		;MASK OUT ALL NON-TTY-TYPE BITS
	JFFO T,.+2
	 SETZ TT,
	JRST FIX1
]		;END OF IFN SAIL

STTYSIZE:
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
IFN SAIL,[
;R GETS SIZE, TT GETS WIDTH
	MOVE F,[-2,,R]		;COUNT OF ARGS,,ADR OF ARGS
	MOVE R,[15,,R]		;TERMINAL SIZE, -1 IF NOT DISPLAY
	MOVE D,[6,,D]		;TERMINAL WIDTH (EXCEPT IF NON-ARPA TTY)
	TTYSET F,		;DO TERMINAL OPERATIONS
	SKIPGE R		;IF USE REAL PAGE LENGTH
	 MOVE R,FO.RPL(TT)
	MOVE TT,D		;LINE LENGTH ENDS UP IN TT
]		;END OF IFN SAIL
	MOVE R,FO.RPL(TT)	;GET REAL PAGE LENGTH
IFE SAIL,[
	MOVE TT,FO.LNL(TT)	;GET LINEL
	ADDI TT,1		;WIDTH IS 1 MORE THAN LINEL
]	;END IFE SAIL
STTYS1:	UNLOCKI
	JSP T,FXCONS
	MOVEI B,(A)
	MOVE TT,R
	JRST CONSFX

;;; GET DEC-10 TERMINAL NUMBER INTO D (-1 FOR OWN TERMINAL).
;;; ENTER WITH TTSAR OF FILE OBJECT IN TT.

D10TNM:
IFN SAIL,[
	MOVE D,F.CHAN(TT)
	SKIPL F.MODE(TT)
	 DEVNUM D,		;GET DEVICE NUMBER
	  SETO D,		;ON FAILURE, OR FOR TTY, USE -1
]		;END OF IFN SAIL
IFE SAIL,[
	SETO D,
	SKIPGE F.MODE(TT)	.SEE FBT.CM
	 POPJ P,
	HRRZ D,F.RDEV(TT)	;CONVERT SIXBIT UNIT NUMBER TO OCTAL
REPEAT 3,[
	DPB D,[360600,,D]
	DPB D,[030300,,D]
	TLNN D,700000
	 LSH D,-3
	LSH D,-3
]		;END OF REPEAT 3
	ANDI D,777
]		;END OF IFE SAIL
	POPJ P,
]		;END OF IFN QIO
]		;END OF IFN D10

IFN D20,[

STTYTYPE:
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
	HRRZ 1,F.JFN(TT)
	GTTYP			;GET TTY TYPE
	MOVE TT,2
	UNLOCKI
	JRST FIX1

STTYSIZE:
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
	HRRZ 1,F.JFN(TT)
	RFMOD			;READ JFN MODE WORD
	LDB R,[.BP TT%LEN,TT]	;GET PAGE LENGTH
	LDB TT,[.BP TT%WID,TT]	;GET WIDTH
	SETZ 2,
STTYS1:	UNLOCKI
	JSP T,FXCONS
	MOVEI B,(A)
	MOVE TT,R
	JRST CONSFX

]		;END OF IFN D20

SUBTTL	STATUS TTYSCAN, TTYCONS, TTYINT

IFN QIO,[

STTYSCAN:
	SKIPN T		;GET TTY PRE-SCAN FUNCTION
	 SKIPA AR1,V%TYI
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP
	 JRST STSCN1
	 JRST STSCN1
	MOVEI A,(AR1)
	MOVEI B,QTTYSCAN
	SETZ C,
	JRST ISTCSH
STSCN1:	]	;END IFN SFA
	PUSHJ P,TIFLOK
	HRRZ A,TI.BFN(TT)
	UNLKPOPJ

SSTTYSCAN:
	CAMN T,XC-1	;SET TTY PRE-SCAN FUNCTION
	 SKIPA AR1,V%TYI
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP		;DO WE HAVE AN SFA?
	 JRST SSTSC1		;NOPE
	 JRST SSTSC1		;DITTO
	POP P,A			;GET THE ARG
	JSP T,%NCONS		;TURN IT INTO A LIST
	MOVEI C,(A)		;AS THE ARG TO THE SFA
	MOVEI B,QTTYSCAN
	MOVEI A,(AR1)
	JRST ISTCSH
SSTSC1:	]	;END IFN SFA
	PUSHJ P,TIFLOK
	POP P,A
	HRRZM A,TI.BFN(TT)
	UNLKPOPJ

STTYCONS:
	MOVEI AR1,(A)		;GET ASSOCIATED TTY FILE OF
	CAIN AR1,TRUTH		; OPPOSITE DIRECTION, IF ANY
	 HRRZ AR1,V%TYI		;PREFER INPUT TTY
IFN SFA,[
	JSP TT,XFOSP
	 JRST STCON1
	 JRST STCON1
	MOVEI A,(AR1)
	MOVEI B,QTTYCONS
	SETZ C,
	JRST ISTCSH
STCON1:	]	;END IFN SFA
	PUSHJ P,TFILOK		;LEAVES ITS ARGUMENT IN AR1
	HRRZ A,FT.CNS(TT)	.SEE TTYMOR
	UNLKPOPJ

SSTTYCONS:
	SKIPE A			;CONS TOGETHER TWO TTY'S INTO
	 CAIN A,TRUTH		; A SINGLE CONSOLE
	  EXCH A,B		;PREFER TO SEE NIL OR T SECOND
	CAIN A,TRUTH		;PREFER INPUT TTY FOR FIRST ARG
	 HRRZ A,V%TYI
SFA%	MOVEI AR1,(A)
IFN SFA,[
	JSP TT,AFOSP		;DO WE HAVE AN SFA?
	 JRST SSTCO1		;NOPE
	 JRST SSTCO1		;NOPE
	MOVEI C,(B)		;YES, PASS THE SECOND ARG AS THE SFA'S ARG
	MOVEI B,QTTYCONS	;TTYCONS IS THE OPERATION
	JRST ISTCSH
SSTCO1:	]	;END IFN SFA
	PUSHJ P,TFILOK
	JUMPE B,SSTC1		;SUNDER THEM IF ONE IS NIL
	MOVEI T,TIFLOK
	TLNN TT,TTS<IO>
	 MOVEI T,TOFLOK
	UNLOCKI
	CAIE B,TRUTH
	 JRST SSTC2
	HRRZ B,V%TYI		;FOR SECOND ARG OF T, USE TTY
	TLNN TT,TTS<IO>		; OF NECESSARY DIRECTION
	 HRRZ B,V%TYO
SSTC2:	MOVEI AR1,(B)
	PUSHJ P,(T)
	HRRZ C,FT.CNS(TT)
	HRRZM A,FT.CNS(TT)	;LINK THIS ONE TO THAT ONE
	MOVEI TT,FT.CNS
	SKIPE C			;IF IT WAS LINKED, UNLINK
	 SETZM @TTSAR(C)	; ITS FORMER PARTNER
	EXCH B,@TTSAR(A)	;LINK THAT ONE TO THIS ONE
	JUMPE B,UNLKTRUE	;????? THINK ABOUT ALL THIS?
	CAIE B,(A)		;IF IT WAS LINKED, UNLINK
	 SETZM @TTSAR(B)	; ITS FORMER PARTNER
	JRST UNLKTRUE

SSTC1:	HRRZ B,FT.CNS(TT)	;GET ASSOCIATED TTY
	SETZM FT.CNS(TT)	;UNLINK THAT FROM THIS
	MOVEI TT,FT.CNS
	SKIPE B			;ONLY UNCONS IF WAS PREVIOUSLY CONSED
	 SETZM @TTSAR(B)	;UNLINK THIS FROM THAT
	JRST UNLKTRUE

;;;	IFN QIO

STTYINT:
	CAMN T,XC-1
	 SKIPA AR1,V%TYI
	  POP P,AR1
	POP P,A
	JSP T,CHNV1
	MOVE F,TT
	PUSHJ P,TIFLOK
	ROT F,-1
	ADDI TT,FB.BUF(F)
	HRRZ A,(TT)
	SKIPL F
	 HLRZ A,(TT)
	UNLKPOPJ

SSTTYINT:
	CAMN T,XC-2
	 SKIPA AR1,V%TYI
	  POP P,AR1
	POP P,A
	JSP T,PDLNMK
	MOVEI B,(A)
	POP P,A
	JSP T,CHNV1
	MOVE F,TT
	PUSHJ P,TIFLOK
	ROT F,-1
20$	PUSH P,TT		;SAVE TTSAR
	ADDI TT,FB.BUF(F)
	JUMPL F,SSTIN1
	HRLM B,(TT)
20%	JRST UNLKTRUE
20$	SKIPA
SSTIN1:	HRRM B,(TT)
20%	JRST UNLKTRUE
IFN D20,[
	POP P,TT		;RESTORE TTSAR
	ROT F,1			;RESTORE CHARACTER
	CAIE F,3		;DON'T ALLOW USE TO ASSIGN ↑C
	 CAILE F,26.		;TOPS-20 ONLY SUPPORTS TO ↑Z
	  JRST UNLKTRUE		;RETURN TRUE, BUT DON'T DO TELL THE OP SYS
	MOVE T,V%TYI		;ONLY DO FOLLOWING IF *THE* TTY
	CAME TT,TTSAR(T)	;CHECK FOR TTSAR OF *THE* TTY
	 JRST UNLKTRUE
	SETZB T,R		;SEARCH FOR A) FREE SLOT, B) EQUIVALENT SLOT
SSTIN2:	CAMN F,CINTAB(T)	;EQUIVALENT SLOT?
	 JRST SSTIN3		;YES, CODE ASSIGNED SO TAKE SPECIAL ACTION
	SKIPN CINTAB(T)		;EMPTY SLOT?
	 MOVEI R,400000(T)	;YES, REMEMBER WE HAVE ONE
	CAIGE T,CINTSZ-1	;DONE ALL OF TABLE?
	 AOJA T,SSTIN2		;NOPE, CONTINUE LOOPING
	JUMPE B,UNLKTRUE	;IF TURNING OFF AND DIDN'T FIND IN TAB, DONE
	SKIPN R			;FOUND A FREE SLOT?
	 JRST SSTIN4
	MOVEM F,CINTAB-400000(R) ;YES, STORE NEW CHARACTER ASSIGNMENT
	CAILE R,400005		;CONVERT TO 400000+<D20 INTERRUPT CHANNEL>
	 ADDI R,22
	HRLZI 1,(F)		;CHARACTER
	HRRI 1,-400000(R)	;INTERRUPT CHANNEL
	ATI			;ASSIGN THE CHARACTER TO THE CHANNEL
	MOVEI A,TRUTH		;RETURN TRUE
	UNLKPOPJ

SSTIN3:	JUMPN B,UNLKTRUE	;RETURN IF CHARACTER WAS ALREADY ASSIGNED
	SETZM CINTAB(T)		;CLEAR THE TABLE ENTRY
	MOVEI 1,(F)		;DEASSIGN THE TERMINAL CODE
	DTI
	JRST UNLKTRUE		;THEN RETURN TRUE

SSTIN4:	UNLOCKI
	FAC [NO FREE INTERRUPT CHANNELS  - (SSTATUS TTYINT)!]
]	;END IFN D20
]		;END OF IFN QIO


SUBTTL	STORAGE SPACE STATUS CALLS

SPDLMAX:
IFN ITS+D20,[
		JSP D,SSGP1	;0 - STATUS PDLMAX
SSPDLMAX:	JSP D,SSGP1	;1 - SSTATUS PDLMAX
]			;END OF IFN ITS+D20
.ELSE	REPEAT 2, 0		;0, 1 UNUSED
SGCSIZE:	JSP D,SSGP1	;2 - STATUS GCSIZE
SSGCSIZE:	JSP D,SSGP1	;3 - SSTATUS GCSIZE
SGCMAX:		JSP D,SSGP1	;4 - STATUS GCMAX
SSGCMAX:	JSP D,SSGP1	;5 - SSTATUS GCMAX
SGCMIN:		JSP D,SSGP1	;6 - STATUS GCMIN
SSGCMIN:	JSP D,SSGP1	;7 - SSTATUS GCMIN
SPDLSIZE:	JSP D,SSGP1	;10 - STATUS PDLSIZE
SPURSIZE:	SKIPA B,A	;14 - STATUS PURSIZE
SSPCSIZE:	 JSP D,SSGP1	;12 - STATUS SPCSIZE
	MOVEI D,14		;FAKE OUT A JSP D,SSGP1
	CAIG B,QRANDOM		;LOSE IF BAD SPACE TYPE
	 CAIGE B,QLIST
	JRST SSGPLZ
   2DIF SKIPN (B),GTNPS8,QLIST
	 JRST SSGPLZ
	JRST SSGP1A

SPDLROOM:
	MOVEI D,20+SPDLMAX+1	;20 - STATUS PDLROOM
SSGP1:	SUBI D,SPDLMAX+1	;GET CODE NUMBER IN D
	MOVEI C,(B)		;YECH - SHUFFLE, SHUFFLE
	MOVEI B,(A)
SSGP1A:	MOVEI AR1,(B)
	CAIN B,QRANDOM		;GET LINEARIZATION BY USING
	 JRST SSGPLZ		; QRANDOM FOR QARRAY
	CAIN B,QARRAY
	 MOVEI B,QRANDOM
	TRNE D,6		;SKIP IF PDLMAX OR PDLSIZE
	 JRST SSGP1C
	CAIL B,QREGPDL
	 CAILE B,QSPECPDL
	  JRST SSGPLZ
	JRST SSGP1D

SSGP1C:	CAIG B,QRANDOM		;LOSE IF BAD SPACE TYPE
	 CAIGE B,QLIST
	JRST SSGPLZ

SSGP1D:	ROT D,-1		;LOW BIT=1 => SSTATUS
	JUMPL D,SSG3A1
	MOVE TT,@SSGPGT(D)	;ELSE GET VALUE TO RETURN
	TRNE D,3
	 JRST SSGP2A
   2DIF [SUB TT,(B)]C2,QREGPDL	;FOR PDL STUFF, CUT DOWN
	TLZ TT,-1		; QUANTITY BY PDL ORIGIN
SSGP2A:	TLNN TT,-1		;HACK SO THAT STATUS GCMIN
	 JRST FIX1		; WILL RETURN A FLONUM
	JRST FLOAT1		; IF APPROPRIATE


SSGPGT:
10%	2DIF (B),XPDL,QREGPDL	;PDLMAX
10$	0			;UNUSED
	2DIF (B),GFSSIZ,QLIST	;GCSIZE
	2DIF (B),XFFS,QLIST	;GCMAX
	2DIF (B),MFFS,QLIST	;GCMIN
	2DIF (B),P,QREGPDL	;PDLSIZE
	2DIF (B),SFSSIZ,QLIST	;SPCSIZE
	2DIF (B),PFSSIZ,QLIST	;PURSIZE
	0			;UNUSED
	2DIF (B),OC2,QREGPDL	;PDLROOM

SSGPLZ:	MOVEI T,SBADSP	;BAD SPACE TYPE (OR MAYBE PDL TYPE?)
	TRNN D,6
	 MOVEI T,[SIXBIT \BAD PDL TYPE - STATUS!\]
	MOVEI A,(AR1)
	%WTA (T)
	MOVEI B,(A)
	JRST SSGP1A

SSGP3$:	JUMPE C,TRUE		;USED BY $ALLOC
;A CHANGE IN POLICY TO ALWAYS ALLOW A FLONUM
SSG3A1:	MOVEI T,(D)
	CAIN T,3		;IF GCMIN,
	 JRST SSGP4		; USE SPECIAL CHECKING CODE
SSGP3A:	SKOTT C,FL		;ALLOW FLONUM
	 JRST SSGP3Z
	MOVE TT,(C)		;GET THE FLONUM
	PUSH FXP,D		;SAVE D OVER CALL TO IFIX
	JSP T,IFIX		;CONVERT TO A FIXNUM
	POP FXP,D
	MOVE R,TT
	JRST SSGP3Y		;THEN HANDLE AS IF FIXNUM
SSGP3Z:	SKOTT C,FX		;MUST BE FIXNUM
	 JRST FALSE
	MOVE R,(C)		;ELSE FETCH THE FIXNUM
SSGP3Y:	TLNE R,-1		;LOSE IF NEG OR TOO LARGE
	 JRST FALSE
	JRST SSGPPT(D)		;ELSE JRST TO SPECIAL ROUTINE

SSGPPT:
10%	JRST SSPM1		;PDLMAX
10$	0
	JRST SSGS1		;GCSIZE
	JRST SSGX1		;GCMAX
SSGM1:	CAIL R,40		;GCMIN
    2DIF [CAMLE D,(B)]SSGMRV,QLIST	;FIXNUM GCMIN MUST HAVE
	  JRST FALSE			; "REASONABLE" VALUE
SSGM2:
   2DIF [MOVEM R,(B)]MFFS,QLIST		;SO SAVE IT, ALREADY
	JRST TRUE

SSGMRV:	20000		;LIST
	10000		;FIXNUM
	4000		;FLONUM
BG$	4000		;BIGNUM
	4000		;SYMBOL
REPEAT HNKLOG, 100000	;HUNKS
	1000		;SAR

SSGP4:	MOVEI A,(C)		;(SSTATUS GCMIN ...) PERMITS
	JSP T,FLTSKP		; A FLONUM ARGUMENT
	 JRST SSGP3A
	JUMPLE TT,FALSE		;BUT MUST BE POSITIVE
	CAML TT,[.005]		; AND BETWEEN .005 AND .95
	 CAMLE TT,[.95]
	  JRST FALSE
	MOVE R,TT
	JRST SSGM2



SSGS1:	ANDI R,SEGMSK
   2DIF [MOVEM R,(B)]GFSSIZ,QLIST	;SET GCSIZE
   2DIF [CAMG R,(B)]XFFS,QLIST		;IF GREATER THAN GCMAX,
	 JRST TRUE			; MUST ALSO SET GCMAX TO MATCH
SSGX1:
   2DIF [CAMGE R,(B)]SFSSIZ,QLIST	;GCMAX MAY NOT BE LESS
	 JRST FALSE			; THAN ACTUAL SIZE
   XCTPRO
   2DIF [HRRZM R,(B)]XFFS,QLIST
   NOPRO
	JRST TRUE

IFN ITS+D20,[
SSPM1:	HRRZ T,P-QREGPDL(B)	;GET CURRENT PDL POINTER
	ADD R,C2-QREGPDL(B)	;UP USER'S VALUE BY PDL ORIGIN
	ANDI R,777760
	TRNN R,PAGKSM
	 SUBI R,20
	CAILE R,(T)		;NEW PDLMAX MUST BE ABOVE
	 CAML R,OC2-QREGPDL(B)	; CURRENT PDL POINTER, AND
	  JRST FALSE		; BELOW ABS OVERFLOW POINT
	HRRZM R,XPDL-QREGPDL(B)
	HRRZM R,ZPDL-QREGPDL(B)	;SO UPDATE CRAP
	HRROS P-QREGPDL(B)	;SET LH OF PDL POINTER TO -1
	JRST TRUE		; SO PDLOV WILL HACK IT PROPERLY
]		;END OF IFN ITS+D20


;;; PART OF PUTPROP - HACK FOR *PURE MODE TO PURIFY PROPERTY LISTS

CSETP1:	PUSH P,B
	MOVEI A,(C)
	MOVE B,VPUTPROP
	PUSHJ P,MEMQ
	POP P,B
	JUMPE A,CSETP7
	PUSH P,C		;NEED TO PURCOPY C(C) ALSO
	MOVEI A,(B)
	PUSHJ P,PURCOPY
	EXCH A,(P)		;REMEMBER THE VALUE, GET THE PROPERTY
	SKOTT A,SY		;IS THE PROPERTY A SYMBOL?
	 JRST CSETNS		;NO
	HLRZ T,(A)		;POINTER TO THE SY2 BLOCK
	MOVE T,SYMVC(T)		;GET THE FLAG BITS
	TLNN T,SY.PUR		;IS IT ALREADY PURE?
	 PUSHJ P,PURCOPY	;NO, PURCOPY IT
CSETNS:	POP P,A			;RESTORE THE VALUE TO BE PUT ON THE PROPERTY
	MOVE T,(P)
CSETP2:	HRRZ B,(T)
	JUMPE B,CSETP3
	MOVEI TT,(B)
	LSH TT,-SEGLOG
	MOVE TT,ST(TT)
	TLNE TT,PUR
	 JRST CSETP3
	HRRZ T,(B)
	JRST CSETP2

CSETP3:	PUSHJ P,PCONS
	MOVEI B,(A)
	MOVEI A,(C)
	PUSHJ P,PCONS
	HRRM A,(T)
	SUB P,R70+1
	JRST $CADR

CSETP7:	HRRZ A,(P)
	JRST CSET2A

SUBTTL	STATUS RANDOM

SRANDOM:
	SETZ B,
	MOVEI F,LRBLOCK-1+2	;+2 FOR RNOWS AND RBACK
SRAND3:	MOVE TT,RNOWS(F)	;CONS UP A LIST SUMMARIZING
	PUSHJ P,CONSFX		; THE STATE OF THE RANDOM
	SOJGE F,SRAND3		; NUMBER GENERATOR
	POPJ P,

SSRAN0:	WTA [BAD ARGUMENT - STATUS RANDOM!]
SSRANDOM:
	SKOTT A,LS
	 JRST SSRAN8
	MOVEI B,(A)
	JSP TT,SSRAN6
	MOVEM R,RNOWS
	JSP TT,SSRAN6
	MOVEM R,RBACK
	MOVNI F,LRBLOCK
SSRAN3:	HLRZ C,(B)
	JSP T,FXNV3
	MOVEM R,RBLOCK+LRBLOCK(F)
	HRRZ B,(B)
	AOJL F,SSRAN3
	JRST TRUE

SSRAN6:	HLRZ C,(B)
	JSP T,FXNV3
	JUMPLE R,SSRAN0
	CAILE R,LRBLOCK+1
	 JRST SSRAN0
	HRRZ B,(B)
	JRST (TT)

SSRAN8:	JSP T,FXNV1
	SKIPN TT		;0 IS BAD VALUE
	 MOVEI TT,1
	JSP F,IRAND0
	JRST TRUE

IFN USELESS,[
IFN ITS,[

SUBTTL	STATUS WHO-LINE [ETC.]

SSWHO1:	SETZ F,
	MOVE D,[441000,,F]
	JSP T,FXNV1
	IDPB TT,D
	MOVEI A,(B)
	JSP T,CHNV1X
	IDPB TT,D
	JSP T,FXNV3
	IDPB R,D
	MOVEI A,(AR1)
	JSP T,CHNV1X
	IDPB TT,D
	.SUSET [.SWHO1,,F]
	JRST TRUE

SSWHO2:	PUSHJ P,SIXNUM
	.SUSET [.SWHO2,,TT]
	JRST TRUE

SSWHO3:	PUSHJ P,SIXNUM
	.SUSET [.SWHO3,,TT]
	JRST TRUE

SWHO1:	.SUSET [.RWHO1,,F]
	MOVEI R,4
	SETZ B,
	MOVE D,[441000,,F]
SWHO1A:	ILDB TT,D
	JSP T,FXCONS
	PUSHJ P,CONS
	MOVEI B,(A)
	SOJG R,SWHO1A
	JRST NREVERSE

SWHO2:	.SUSET [.RWHO2,,TT]
	JRST FIX1

SWHO3:	.SUSET [.RWHO3,,TT]
	JRST FIX1

SIXNUM:	SKOTT A,FX
	 JRST SIXMAK
	POP P,T
	JRST FXNV1

;;;	IFN USELESS
;;;	IFN ITS

IFN QIO,[

SMAR:	MOVE T,IMASK
	TRNN T,%PIMAR		;NIL IF LISP NOT USING MAR
	 JRST FALSE		; (BUT SUPERIOR MIGHT BE)
	.SUSET [.RMARA,,D]
	HLRZ TT,D
	MOVEI A,(D)
	PUSHJ P,ACONS
	MOVEI B,(A)
	JRST CONSFX		;RETURN LIST OF (MODE, LOCATION)

SSMAR:	MOVEI F,%PIMAR
	JSP T,FXNV1
	TRZ TT,4
	JUMPE TT,SSMAR5
	IORM F,IMASK
	.SUSET [.SIMASK,,F]
	HRLI B,(TT)
	.SUSET [.SMARA,,B]
	JRST TRUE

SSMAR5:	.SUSET [.SMARA,,R70]
	ANDCAM F,IMASK
	.SUSET [.SAMASK,,F]
	JRST TRUE

SFTV:	TDZA AR2A,AR2A		;MOBY I/O CRUD
SSFTV:	 MOVEI AR2A,1		;AUTOLOADS FROM COM:NVID FASL
	JCALL 5,QSFTV.
SFTVSIZE:	MOVEI AR2A,2
	JCALL 5,QSFTV.
SSFTVSIZE:	MOVEI AR2A,3
	JCALL 5,QSFTV.
SFTVTITLE:	MOVEI AR2A,4
	JCALL 5,QSFTV.

SSGCWHO:	JSP T,FXNV1
	ANDI TT,3
	MOVEM TT,GCWHO
	JRST TRUE

;;;	IFN USELESS
;;;	IFN ITS

;;;	IFN QIO

SITS:	.CALL SITS9
	 .VALUE
	PUSH FXP,T
	JSP T,IFLOAT
	FDVRI TT,(30.0)
	JSP T,FLCONS
	SETZ B,
	PUSHJ P,CONSIT
	POP FXP,TT
	PUSHJ P,CONSFX
	MOVE TT,D
	PUSHJ P,CONSFX
	MOVE TT,R
	PUSHJ P,CONSFX
	MOVE TT,F
	JSP T,IFLOAT
	SKIPL TT
	 FDVRI TT,(30.0)
	JSP T,FLCONS
	JRST CONS

SITS9:	SETZ
	SIXBIT \SSTATU\
	  2000,,F		;TIME UNTIL SYSTEM GOES DOWN
	  2000,,R		;SYSTEM BEING DEBUGGED
	  2000,,D		;NUMBER OF LOSERS
	  2000,,T		;NUMBER OF MEMORY ERRORS
	402000,,TT		;TIME SYSTEM HAS BEEN UP

]		;END OF IFN QIO

]		;END OF IFN ITS
]		;END OF IFN USELESS

SUBTTL	ASCII TABLE OF STATUS FUNCTIONS

;;; ***** ASCII TABLE OF STATUS FUNCTIONS ***** PART 1 *****

STBA:
Q%	ASCII \IOC\		;IOC (I/O CONTROL)
	ASCII \MACRO\		;MACRO
	ASCII \DIVOV\		;DIVOV (DIVIDE OVERFLOW)
	ASCII \TTY\		;TTY 
	ASCII \TOPLE\		;TOPLEVEL
	ASCII \BREAK\		;BREAKLEVEL
	ASCII \UREAD\		;UREAD
	ASCII \UWRIT\		;UWRITE
	ASCII \+\		;+ (SUPRA-DECIMAL DIGITS OPTION)
	ASCII \GCMIN\		;GCMIN
	ASCII \SYNTA\		;SYNTAX
	ASCII \CHTRA\		;CHTRAN (CHARACTER TRANSLATION)
Q%	ASCII \INTER\		;INTERRUPT
Q$	ASCII \TTYIN\		;TTYINT
	ASCII \GCTIM\		;GCTIME
	ASCII \LOSEF\		;LOSEF (LAP OBJECT STORAGE EFFICIENCY FACTOR)
	ASCII \TERPR\		;TERPRI (SUPPRESSION OF AUTO-TERPRI)
	ASCII \←\		;← (CAN PRIN1 USE ← FIXNUM SYNTAX)
Q%	ASCII \PAGEP\		;PAGEPAUSE
	ASCII \TTYRE\		;TTYREAD
	ASCII \FEATU\		;FEATURE
	ASCII \NOFEA\		;NOFEATURE
IFN USELESS,	ASCII \ABBRE\	;ABBREVIATE
	ASCII \UUOLI\		;UUOLINKS
	ASCII \GCMAX\		;GCMAX
IFN PAGING,	ASCII \PDLMA\	;PDLMAX
	ASCII \GCSIZ\		;GCSIZE
	ASCII \LINMO\		;LINMODE
	ASCII \CRFIL\		;CRFILE (CURRENT FILE)
	ASCII \CRUNI\		;CRUNIT (CURRENT UNIT)
	ASCII \EVALH\		;EVALHOOK (FOR MULTICS COMPATIBILITY)
Q$	ASCII \TTYSC\		;TTYSCAN
Q$	ASCII \TTYCO\		;TTYCONS
	ASCII \RANDO\		;RANDOM
IFN USELESS,[
IFN ITS,[
	ASCII \WHO1\		;WHO1	;ITS WHO-LINE
	ASCII \WHO2\		;WHO2	; DISPLAY
	ASCII \WHO3\		;WHO3	; VARIABLES
Q$	ASCII \MAR\		;MAR	;MAR BREAK FEATURE
Q$	ASCII \GCWHO\
]		;END OF IFN ITS
]		;END OF IFN USELESS
IFN MOBIOF+QIO*ITS*USELESS,[
	ASCII \FTV\		;FTV (FAKE TV)
	ASCII \FTVSI\		;FTVSIZE
]		;END OF IFN MOBIOF+QIO*ITS*USELESS
	ASCII \PUNT\		;PUNT	;TRUE MEANS NO FUNCTIONAL VARIABLES
IFN PAGING, ASCII \FLUSH\	;FLUSH  ;NON-NIL MEANS FLUSH PAGES UPON
					; A SUSPEND
IFN USELESS*ITS, ASCII \CLI\	;CLI 	;DISABLE/ENABLE CLI INTERRUPTS

LSSTBA==.-STBA		;END OF ENTRIES WHICH CAN BE SSTATUS'D

;;; ***** ASCII TABLE OF STATUS FUNCTIONS ***** PART 2 *****

IFN MOBIOF+QIO*ITS*USELESS, ASCII \FTVTI\	;FTVTITLE
	ASCII \PURSI\		;PURSIZE
	ASCII \PDLSI\		;PDLSIZE
	ASCII \DAYTI\		;DAYTIME
	ASCII \DATE\		;DATE
IFN USELESS,	ASCII \DOW\	;DOW (DAY OF WEEK)
IT$	ASCII \TTYSI\		;TTYSIZE (HEIGHT . WIDTH)
	ASCII \UNAME\		;UNAME (USER NAME)
	ASCII \USERI\		;USERID
	ASCII \XUNAM\		;XUNAME
	ASCII \JNAME\		;JNAME (JOB NAME)
	ASCII \SUBSY\		;SUBSYSTEM
	ASCII \JNUMB\		;JNUMBER
	ASCII \HOMED\		;HOMEDIR (HOME DIRECTORY NAME)
	ASCII \HSNAM\		;HSNAME (SMART HOME DIRECTORY NAME)
	ASCII \LISPV\		;LISPVERSION
	ASCII \JCL\		;JCL (JOB COMMAND LINE)
IT$	ASCII \HACTR\		;HACTRN
	ASCII \UDIR\		;UDIR (USER DIRECTORY NAME)
	ASCII \FXPDL\		;FXPDL (FIXNUM PDL)
	ASCII \FLPDL\		;FLPDL (FLONUM PDL)
	ASCII \PDL\		;PDL (REG PDL)
	ASCII \SPDL\		;SPDL (SPECIAL PDL)
	ASCII \BPSL\		;BPSL (BINARY PROGRAM SPACE LOW)
	ASCII \BPSH\		;BPSH (BINARY PROGRAM SPACE HIGH)
	ASCII \SEGLO\		;SEGLOG (LOG2 OF SEGMENT SIZE)
	ASCII \SYSTE\		;SYSTEM (SYSTEM ATOM)
	ASCII \TABSI\		;TABSIZE
	ASCII \SPCNA\		;SPCNAMES (NAMES OF DATA SPACES)
	ASCII \PURSP\		;PURSPCNAMES
	ASCII \PDLNA\		;PDLNAMES
	ASCII \SPCSI\		;SPCSIZE
	ASCII \PDLRO\		;PDLROOM
	ASCII \MEMFR\		;MEMFREE
	ASCII \NEWLI\		;NEWLINE
Q$	ASCII \FILEM\		;FILEMODE
Q$	ASCII \TTYTY\		;TTYTYPE
IT$ Q$	ASCII \OSPEE\		;OSPEED
Q$	ASCII \FASLO\		;FASLOAD (RETURNS CURRENT LDBSAR)
IFN USELESS,[
IFN ITS,[
Q$	ASCII \ITS\		;ITS
]		;END OF IFN ITS
]		;END OF IFN USELESS
	ASCII \STATU\		;STATUS
	ASCII \SSTAT\		;SSTATUS
	ASCII \ARRAY\		;ARRAY
LSTBA==.-STBA

SUBTTL	STATUS DISPATCH TABLES

;;; FORMAT  <4.9-4.7> , <4.6-3.8> , <2.9-1.1>
.FORMAT 37,002231104103

RADIX 4

;;; MAGIC TABLE OF STATUS OPERATIONS
;;;	4.9-4.7	OPERATION TYPE
;;;		0	SUBR-TYPE FUNCTION
;;;		1	LSUBR-TYPE FUNCTION
;;;		2	SUBR-TYPE WITH CHAR FIRST ARG
;;;		3	LSUBR-TYPE WITH CHAR FIRST ARG
;;;		4	GET LISP VALUE
;;;		5	SET LISP VALUE
;;;		6	SET TO T-OR-NIL
;;;		7	GET FIXNUM VALUE
;;;	4.6-4.5	ARGUMENT 1 TYPE
;;;		0	NO MORE ARGS
;;;		1	QUOTED ARGUMENT
;;;		2	TAKE REST AS QUOTED LIST
;;;		3	EVALUATED ARGUMENT
;;;	4.4-4.3	ARGUMENT 2 TYPE
;;;	4.2-4.1	ARGUMENT 3 TYPE
;;;	3.9-3.8	ARGUMENT 4 TYPE
;;;	3.7-3.1	ARGS INFO

;;;	.FORMAT 37,002231104103

;;;	RADIX 4


;;; ***** SSTATUS FUNCTION TABLE ***** MUST MATCH ASCII TABLE *****

STBSS:
Q%	0,2000,IOC		(FA1N&1333)	;IOC
	3,1310,SSMACRO		(FA23)	;MACRO
	6,3000,RWG		(FA1)	;DIVOV
Q%	0,3300,SSTTY		(FA2)	;TTY
Q$ IT$	1,3333,SSTTY		(FA1234&1333)	;TTY
Q$ 20$	1,3333,SSTTY		(FA1N&1333)	;TTY
Q$ 10$ SA%	1,3333,SSTTY	(FA12)		;TTY
Q$ 10$ SA$	1,3333,SSTTY	(FA1N&1333)	;TTY
	5,3000,TLF		(FA1)	;TOPLEVEL
	5,3000,BLF		(FA1)	;BREAKLEVEL
	0,2000,UREAD		(FA0234);UREAD
	0,2000,UWRITE		(FA012)	;UWRITE
	0,3000,SSPLSS		(FA1)	;+
	0,3300,SSGCMIN		(FA2)	;GCMIN
	2,1300,SSSYNTA		(FA2)	;SYNTAX
	2,1300,SSCHTRA		(FA2)	;CHTRAN
Q%	0,3300,SSINTERRUPT	(FA2)	;INTERRUPT
Q$	1,3330,SSTTYINT		(FA23)	;TTYINT
	0,3000,SSGCTIM		(FA1)	;GCTIME
	0,3000,SSLOSEF		(FA1)	;LOSEF
Q%	0,3000,SSTERPRI		(FA1)	;TERPRI
Q$	1,3300,SSTERPRI		(FA12)	;TERPRI
	0,3000,SSLAP		(FA1)	;←
Q%	5,3000,SPP		(FA1)	;PAGEPAUSE
	0,3000,SSTTYREAD	(FA1)	;TTYREAD
	0,1000,SSFEATURE	(FA1)	;FEATURE
	0,1000,SSNOFEATURE	(FA1)	;NOFEATURE
IFN USELESS,	0,3000,SSABBREVIATE	(FA1)	;ABBREVIATE
	0,0000,SSUUOLINKS	(FA0)	;UUOLINKS
	0,3300,SSGCMAX		(FA2)	;GCMAX
IFN PAGING,	0,3300,SSPDLMAX	(FA2)	;PDLMAX
	0,3300,SSGCSIZE		(FA2)	;GCSIZE
Q% IT$	0,3000,SSLINMODE	(FA1)	;LINMODE
Q% 10$	5,3000,LINMODE		(FA1)	;LINMODE
Q$	1,3300,SSLINMODE	(FA12)	;LINMODE
20%	0,2000,SSCRFIL		(FA2)	;CRFILE
20$	0,2000,SSCRFIL		(FA23)	;CRFILE
	0,2000,CRUNIT		(FA012)	;CRUNIT
	0,3000,FALSE		(FA1)	;EVALHOOK
Q$	1,3300,SSTTYSCAN	(FA12)	;TTYSCAN
Q$	0,3300,SSTTYCONS	(FA2)	;TTYCONS
	0,3000,SSRANDOM		(FA1)	;RANDOM
IFN USELESS,[
IFN ITS,[
	0,3333,SSWHO1		(FA4)	;WHO1
	0,3000,SSWHO2		(FA1)	;WHO2
	0,3000,SSWHO3		(FA1)	;WHO3
Q$	0,3300,SSMAR		(FA2)	;MAR
Q$	0,3000,SSGCWHO		(FA1)	;GCWHO
]		;END OF IFN ITS
]		;END OF IFN USELESS
IFN MOBIOF+QIO*ITS*USELESS,[
	0,2000,SSFTV		(FA0234)	;FTV
	0,3000,SSFTVS		(FA1)		;FTVSIZE
]		;END OF IFN MOBIOF+QIO*ITS*USELESS
	6,3000,EVPUNT		(FA1)	;PUNT
IFN PAGING, 6,3000,SUSFLS	(FA1)	;FLUSH
IFN USELESS*ITS, 0,3000,SSCLI	(FA1)	;CLI
LSST==.-STBSS

IFN LSST-LSSTBA, WARN [WRONG LENGTH SSTATUS TABLE]

;;;	.FORMAT 37,002231104103

;;;	RADIX 4

;;; ***** STATUS FUNCTION TABLE ***** PART 1 (MATCHES STBSS) *****

STBS:
Q%	0,1000,SIOC		(FA1)	;IOC
	2,1000,SMACRO		(FA1)	;MACRO
	4,0000,RWG		(FA0)	;DIVOV
Q%	0,0000,STTY		(FA0)	;TTY
Q$	1,3000,STTY		(FA01)	;TTY
	4,0000,TLF		(FA0)	;TOPLEVEL
	4,0000,BLF		(FA0)	;BREAKLEVEL
	0,0000,SUREAD		(FA0)	;UREAD
	0,0000,SUWRITE		(FA0)	;UWRITE
	0,0000,SPLSS		(FA0)	;+
	0,3000,SGCMIN		(FA1)	;GCMIN
	2,1000,SSYNTAX		(FA1)	;SYNTAX
	2,1000,SCHTRAN		(FA1)	;CHTRAN
Q%	0,3000,SINTERRUPT	(FA1)	;INTERRUPT
Q$	1,3300,STTYINT		(FA12)	;TTYINT
	0,0000,SGCTIM		(FA0)	;GCTIM
	0,0000,SLOSEF		(FA0)	;LOSEF
Q%	0,0000,STERPRI		(FA0)	;TERPRI
Q$	1,3000,STERPRI		(FA01)	;TERPRI
	0,0000,SLAP		(FA0)	;←
Q%	4,0000,SPP		(FA0)	;PAGEPAUSE
	0,0000,STTYREAD		(FA0)	;TTYREAD
	0,2000,SFEATURES	(FA01)	;FEATURES
	0,2000,SNOFEATURE	(FA1)	;NOFEATURE
IFN USELESS,	0,0000,SABBREVIATE	(FA0)	;ABBREVIATE
	0,0000,SUUOLINKS	(FA0)	;UUOLINKS
	0,3000,SGCMAX		(FA1)	;GCMAX
IFN PAGING,	0,3000,SPDLMAX	(FA1)	;PDLMAX
	0,3000,SGCSIZE		(FA1)	;GCSIZE
Q%	4,0000,LINMODE		(FA0)	;LINMODE
Q$	1,3000,SLINMODE		(FA01)	;LINMODE
	0,0000,SCRFIL		(FA0)	;CRFILE
	0,0000,SCRUNIT		(FA0)	;CRUNIT
	0,0000,FALSE		(FA0)	;EVALHOOK
Q$	1,3000,STTYSCAN		(FA01)	;TTYSCAN
Q$	0,3000,STTYCONS		(FA1)	;TTYCONS
	0,0000,SRANDOM		(FA0)	;RANDOM
IFN USELESS,[
IFN ITS,[
	0,0000,SWHO1		(FA0)	;WHO1
	0,0000,SWHO2		(FA0)	;WHO2
	0,0000,SWHO3		(FA0)	;WHO3
Q$	0,0000,SMAR		(FA0)	;MAR
Q$	7,0000,GCWHO		(FA0)	;GCWHO
]		;END OF IFN ITS
]		;END OF IFN USELESS
IFN MOBIOF,[
	0,0000,SFTV		(FA0)	;FTV
	7,0000,MFTVBL		(FA0)	;FTVSIZE
]		;END OF IFN MOBIOF
IFN QIO*ITS*USELESS,[
	0,0000,SFTV		(FA0)	;FTV
	0,0000,SFTVSIZE		(FA0)	;FTVSIZE
]		;END OF QIO*ITS*USELESS
	4,0000,EVPUNT		(FA0)	;PUNT
IFN PAGING, 4,0000,SUSFLS	(FA0)	;FLUSH
IFN USELESS*ITS, 0,3000,SCLI	(FA0)	;CLI
IFN .-STBS-LSSTBA, WARN [WRONG LENGTH STATUS TABLE PART 1]

;;;	.FORMAT 37,002231104103

;;;	RADIX 4

;;; ***** STATUS FUNCTION TABLE ***** PART 2 (NON-SSTATUS ITEMS) *****

IFN MOBIOF+QIO*ITS*USELESS,[
	0,0000,SFTVTITLE	(FA0)	;FTVTITLE
]		;END OF IFN MOBIOF+QIO*ITS*USELESS
	0,3000,SPURSIZE		(FA1)	;PURSIZE
	0,3000,SPDLSIZE		(FA1)	;PDLSIZE
	0,0000,STIME		(FA0)	;DAYTIME
	0,0000,SDATE		(FA0)	;DATE
IFN USELESS,	0,0000,SDOW	(FA0)	;DOW (DAY OF WEEK)
IT$ Q%	0,0000,STTYSIZE		(FA0)	;TTYSIZE
IT$ Q$	1,3000,STTYSIZE		(FA01)	;TTYSIZE
	0,0000,SUNAME		(FA0)	;UNAME
	0,0000,SUSERID		(FA0)	;USERID
	0,0000,SUSERID		(FA0)	;XUNAME
	0,0000,SJNAME		(FA0)	;JNAME
	0,0000,SSUBSYSTEM	(FA0)	;SUBSYSTEM
	0,0000,SJNUMBER		(FA0)	;JNUMBER
IT$	0,0000,SHOMED		(FA0)	;HOMEDIR
IT%	4,0000,SUDIR		(FA0)	;HOMEDIR
	1,3300,SHSNAME		(FA012)	;HSNAME
	0,0000,SLVRNO		(FA0)	;LISPVERSION
IT$	0,0000,SJCL		(FA0)	;JCL
IT%	4,0000,VNIL		(FA0)	;DECSYSTEM-10 HAS NO JCL
20$	WARN [TOPS-20 JCL?]
IT$	0,0000,SDDTP		(FA0)	;HACTRN
	4,0000,SUDIR		(FA0)	;UDIR
	7,0000,FXC2		(FA0)	;FXPDL
	7,0000,FLC2		(FA0)	;FLPDL
	7,0000,C2		(FA0)	;PDL
	7,0000,SC2		(FA0)	;SPDL
	7,0000,BPSL		(FA0)	;BPSL (ORIGINAL BPS LOW)
	7,0000,BPSH		(FA0)	;BPS HIGH
	7,0000,[SEGLOG]		(FA0)	;SEGLOG
	0,3000,SSYSTEM		(FA1)	;SYSTEM
	7,0000,IN10		(FA0)	;TABSIZE
	4,0000,[SPCNAMES]	(FA0)	;SPCNAMES
	4,0000,[PURSPCNAMES]	(FA0)	;PURSPCNAMES
	4,0000,[PDLNAMES]	(FA0)	;PDLNAMES
	0,3000,SSPCSIZE		(FA1)	;SPCSIZE
	0,3000,SPDLROOM		(FA1)	;PDLROOM
	0,0000,SMEMFREE		(FA0)	;MEMFREE
	7,0000,IN0+↑M		(FA0)	;NEWLINE
Q$	0,3000,SFILEMODE	(FA1)	;FILEMODE
Q$	1,3000,STTYTYPE		(FA01)	;TTYTYPE
IT$ Q$	1,3000,SOSPEED		(FA01)	;OSPEED
Q$	4,0000,LDBSAR		(FA0)	;FASLOAD
IFN USELESS,[
IFN ITS,[
Q$	0,0000,SITS		(FA0)	;ITS
]		;END OF IFN ITS
]		;END OF IFN USELESS
	1,1000,SSSS		(FA01)	;STATUS
	1,1000,SSSSS		(FA01)	;SSTATUS
	0,0000,SARRAY		(FA0)	;ARRAY
IFN .-STBS-LSTBA, WARN [WRONG LENGTH STATUS TABLE PART 2]

RADIX 8

.FORMAT 37,0	;MAKE FORMAT 37 ILLEGAL AGAIN
ββ